1 Vergleich von Klassifikationsmethoden in simulierten EMA-Daten


“EMA_5.5” besteht aus je 5 MZP im Pre- und im Post-Intervall. Dies sind die ursprünglich simulierten EMA-Daten von N = 8040 Personen (ursprünglich N = 100.000).

“EMA_30.30” besteht aus je 30 MZP im Pre- und im Post-Intervall. Diese wurden aus den ursprünglichen Simulationsdaten erweitert und umfassen dieselben N = 8040 Personen.

“EMA_5.5_Window” besteht aus je 5 MZP im Pre- und im Post-Intervall, wobei diese (pro Person) jeweils als zusammenhängendes Intervall (Window) zufällig aus den Gesamt-Intervallen ausgewählt wurden. Die Stichprobe umfasst dieselben N = 8040 Personen.

“EMA_5.5_Days” besteht aus je 5 MZP im Pre- und im Post-Intervall, wobei diese pro Person jeweils unzusammenhängend zufällig aus den Gesamt-Intervallen ausgewählt wurden. Die Stichprobe umfasst dieselben N = 8040 Personen.

# Ausschluss von Personen ohne Varianz in min. einem MZP-Intervall

# sd(c(1,1,1,1,2)) = 0.4472136 = min. SD bei 5 (nicht gleichen) MZP
# sd(c(1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,2)) = 0.1825742 = min. SD bei 30 (nicht gleichen) MZP

EMA_5.5 = EMA_5.5 %>% 
  filter(ind.pretestSD != 0 & ind.posttestSD != 0)

EMA_30.30 = EMA_30.30 %>% 
  filter(ind.pretestSD != 0 & ind.posttestSD != 0)


EMA_5.5 = EMA_5.5 %>% 
  filter(ID_orig %in% EMA_30.30$ID1_PRE)

EMA_30.30 = EMA_30.30 %>% 
  filter(ID1_PRE %in% EMA_5.5$ID_orig)

EMA_5.5 = EMA_5.5 %>% 
  add_column(., .before = "ID_orig", ID = 1:nrow(.))

EMA_30.30 = EMA_30.30 %>% 
  add_column(., .before = "ID1_PRE", ID = 1:nrow(.))
load("cor_04_k20/EMA_5.5_Window.RData")
load("cor_04_k20/EMA_5.5_Days.RData")

EMA_5.5_Window$PRE_Mean = apply(EMA_5.5_Window[pre_5mzp], 1, mean)
EMA_5.5_Window$POST_Mean = apply(EMA_5.5_Window[post_5mzp], 1, mean)
EMA_5.5_Window$MeanDiff = EMA_5.5_Window$PRE_Mean - EMA_5.5_Window$POST_Mean
EMA_5.5_Window$ind.pretestSD = apply(EMA_5.5_Window[pre_5mzp], 1, sd)
EMA_5.5_Window$ind.posttestSD = apply(EMA_5.5_Window[post_5mzp], 1, sd)

EMA_5.5_Days$PRE_Mean = apply(EMA_5.5_Days[pre_5mzp], 1, mean)
EMA_5.5_Days$POST_Mean = apply(EMA_5.5_Days[post_5mzp], 1, mean)
EMA_5.5_Days$MeanDiff = EMA_5.5_Days$PRE_Mean - EMA_5.5_Days$POST_Mean
EMA_5.5_Days$ind.pretestSD = apply(EMA_5.5_Days[pre_5mzp], 1, sd)
EMA_5.5_Days$ind.posttestSD = apply(EMA_5.5_Days[post_5mzp], 1, sd)
# Ausschluss von Personen ohne Varianz in min. einem MZP-Intervall

EMA_5.5_Window = EMA_5.5_Window %>% 
  filter(ind.pretestSD != 0 & ind.posttestSD != 0)

EMA_5.5_Days = EMA_5.5_Days %>% 
  filter(ind.pretestSD != 0 & ind.posttestSD != 0)

EMA_5.5 = EMA_5.5 %>% 
  filter(ID %in% EMA_30.30$ID & ID %in% EMA_5.5_Window$ID & ID %in% EMA_5.5_Days$ID)

EMA_30.30 = EMA_30.30 %>% 
  filter(ID %in% EMA_5.5$ID & ID %in% EMA_5.5_Window$ID & ID %in% EMA_5.5_Days$ID)

EMA_5.5_Window = EMA_5.5_Window %>% 
  filter(ID %in% EMA_5.5$ID & ID %in% EMA_30.30$ID & ID %in% EMA_5.5_Days$ID)

EMA_5.5_Days = EMA_5.5_Days %>% 
  filter(ID %in% EMA_5.5$ID & ID %in% EMA_30.30$ID & ID %in% EMA_5.5_Window$ID)

EMA_5.5$ID = 1:nrow(EMA_5.5)
EMA_30.30$ID = 1:nrow(EMA_30.30)
EMA_5.5_Window$ID = 1:nrow(EMA_5.5_Window)
EMA_5.5_Days$ID = 1:nrow(EMA_5.5_Days)

1.1 Überblick über die simulierten Daten

Beispiel-Verläufe in den 4 untersuchten Datensets

1.1.1 Original-Simulationsdaten (je 5 MZP)

EMA_5.5 %>%
  within(., {ind.pretestSD = round(ind.pretestSD, digits = 2)
            ind.posttestSD = round(ind.posttestSD, digits = 2)}) %>% 
  head() %>% 
  kable() %>% 
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE) %>% 
  scroll_box(width = "100%")
ID ID_orig PRE1_1 PRE1_2 PRE1_3 PRE1_4 PRE1_5 POST1_1 POST1_2 POST1_3 POST1_4 POST1_5 PRE_Mean POST_Mean MeanDiff ind.pretestSD ind.posttestSD
1 1 9 8 14 10 17 5 2 2 6 3 11.6 3.6 8.0 3.78 1.82
2 3 8 9 11 12 7 5 4 5 7 2 9.4 4.6 4.8 2.07 1.82
3 4 11 10 5 7 5 18 7 9 5 14 7.6 10.6 -3.0 2.79 5.32
4 5 12 7 14 12 12 10 12 6 6 7 11.4 8.2 3.2 2.61 2.68
5 6 12 12 14 8 9 1 1 8 13 8 11.0 6.2 4.8 2.45 5.17
6 7 8 15 8 8 8 3 4 4 6 11 9.4 5.6 3.8 3.13 3.21


Pre-Post-Verläufe für 9 zufällig gezogene Personen

rand = sample(EMA_5.5$ID, 9)

x = tibble(ID = c(rep(rand[1],times=11),
                  rep(rand[2],times=11),
                  rep(rand[3],times=11),
                  rep(rand[4],times=11),
                  rep(rand[5],times=11),
                  rep(rand[6],times=11),
                  rep(rand[7],times=11),
                  rep(rand[8],times=11),
                  rep(rand[9],times=11)),
           MZP = rep(seq(as.Date("2020-01-01"), length.out=11, by="1 day"), times=9),
           Score = c(as.numeric(EMA_5.5[rand[1],pre_5mzp]), NA, as.numeric(EMA_5.5[rand[1],post_5mzp]),
                     as.numeric(EMA_5.5[rand[2],pre_5mzp]), NA, as.numeric(EMA_5.5[rand[2],post_5mzp]),
                     as.numeric(EMA_5.5[rand[3],pre_5mzp]), NA, as.numeric(EMA_5.5[rand[3],post_5mzp]),
                     as.numeric(EMA_5.5[rand[4],pre_5mzp]), NA, as.numeric(EMA_5.5[rand[4],post_5mzp]),
                     as.numeric(EMA_5.5[rand[5],pre_5mzp]), NA, as.numeric(EMA_5.5[rand[5],post_5mzp]),
                     as.numeric(EMA_5.5[rand[6],pre_5mzp]), NA, as.numeric(EMA_5.5[rand[6],post_5mzp]),
                     as.numeric(EMA_5.5[rand[7],pre_5mzp]), NA, as.numeric(EMA_5.5[rand[7],post_5mzp]),
                     as.numeric(EMA_5.5[rand[8],pre_5mzp]), NA, as.numeric(EMA_5.5[rand[8],post_5mzp]),
                     as.numeric(EMA_5.5[rand[9],pre_5mzp]), NA, as.numeric(EMA_5.5[rand[9],post_5mzp])))

x %>%
  group_by(ID) %>% 
  plot_time_series(MZP, Score,
    #.color_var = ID,           # for multiple lines in one plot
    #.color_lab = "ID",
    .facet_ncol = 3,
    .facet_scales = "fixed",
    .interactive = TRUE,
    .facet_collapse = FALSE,
    .smooth = TRUE,
    .smooth_degree = 2,
    .smooth_alpha = 0.5,
    .smooth_size = 0.2
  )
# don´t run this section (code for extremely computation-intense plots that I already stored as .RData and .jpg)
# repeated-measures scatter-boxplot-violin-histograms for individual PRE and POST means
# from van Langen (2020) Open-visualizations tutorial for repeated measures in R

# EMA_5.5
# converting my dataframes to use in the same ggplot structure:
EMA_5.5_ts = EMA_5.5 %>% 
  select(ID, PRE_Mean, POST_Mean) %>% 
  pivot_longer(!ID, names_to = "Interval", values_to = "Mean") %>% 
  mutate(ID = as.factor(ID),
         Interval = rep(c(1,2), times = nrow(EMA_5.5)))

save(EMA_5.5_ts, file = "Time Series Dataframes/k20_EMA_5.5_ts.RData")

###

load("Time Series Dataframes/k20_EMA_5.5_ts.RData")

# Repeated measures with box− and violin plots
EMA_5.5_ts$jit = jitter(EMA_5.5_ts$Interval, amount = .09)

Pre_Post_Box_Violin = ggplot(data = EMA_5.5_ts, aes(y = Mean)) +
  geom_point(data = EMA_5.5_ts %>% filter(Interval == "1"), aes(x = jit), color = "dodgerblue", size = 1,
             alpha = .5) +
  geom_point(data = EMA_5.5_ts %>% filter(Interval == "2"), aes(x = jit), color = "darkorange", size = 1,
             alpha = .5) +
  geom_line(aes(x = jit, group = ID), color = "lightgray", alpha = .05) +
  geom_half_boxplot(
    data = EMA_5.5_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = -.25),
    side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = TRUE, width = .1,
    fill = "dodgerblue", alpha = .5) +
  geom_half_boxplot(
    data = EMA_5.5_ts %>% filter(Interval == "2"), aes(x = Interval, y = Mean), position = position_nudge(x = .15),
    side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = TRUE, width = .1,
    fill = "darkorange", alpha = .5) +
  geom_half_violin(
    data = EMA_5.5_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = 1.3),
    side = "r", fill = "dodgerblue", alpha = .5, trim = FALSE) +
  geom_half_violin(
    data = EMA_5.5_ts %>% filter(Interval == "2"), aes(x = Interval, y = Mean), position = position_nudge(x = .3),
    side = "r", fill = "darkorange", alpha = .5, trim = FALSE) +
  scale_x_continuous(breaks = c(1,2), labels = c("PRE", "POST"), limits = c(0, 3)) +
  xlab("Interval") + ylab("PHQ-9 Mean Score") +
  #ggtitle("EMA Data (5+5 Timepoints): Individual Pre-Post Means") +
  #theme_classic() +
  theme_bw() +
  coord_cartesian(ylim = c(0, 24))

ggsave("Time Series Dataframes/k20_EMA_5.5_Pre-Post_Box_Violin.jpg", plot = Pre_Post_Box_Violin, width = 6, height = 4)
save(Pre_Post_Box_Violin, file = "Time Series Dataframes/k20_EMA_5.5_Pre_Post_Box_Violin.RData")


# Repeated measures with box− and violin plots and means + CIs
score_mean_1 = EMA_5.5_ts %>% filter(Interval == "1") %>% summarise(mean(Mean)) %>% as.numeric()
score_mean_2 = EMA_5.5_ts %>% filter(Interval == "2") %>% summarise(mean(Mean)) %>% as.numeric()
score_median1 = EMA_5.5_ts %>% filter(Interval == "1") %>% summarise(median(Mean)) %>% as.numeric()
score_median2 = EMA_5.5_ts %>% filter(Interval == "2") %>% summarise(median(Mean)) %>% as.numeric()
score_sd_1 = EMA_5.5_ts %>% filter(Interval == "1") %>% summarise(sd(Mean)) %>% as.numeric()
score_sd_2 = EMA_5.5_ts %>% filter(Interval == "2") %>% summarise(sd(Mean)) %>% as.numeric()
score_se_1 = score_sd_1/sqrt(nrow(EMA_5.5))
score_se_2 = score_sd_2/sqrt(nrow(EMA_5.5))
score_ci_1 = EMA_5.5_ts %>% filter(Interval == "1") %>% pull(Mean) %>% CI(., ci = 0.95)
score_ci_2 = EMA_5.5_ts %>% filter(Interval == "2") %>% pull(Mean) %>% CI(., ci = 0.95)
#Create data frame with 2 rows and 7 columns containing the descriptives
group = c("PRE", "POST")
N = c(nrow(EMA_5.5), nrow(EMA_5.5))
score_mean = c(score_mean_1, score_mean_2)
score_median = c(score_median1, score_median2)
sd = c(score_sd_1, score_sd_2)
se = c(score_se_1, score_se_2)
ci = c(as.numeric(score_ci_1[1] - score_ci_1[3]), as.numeric(score_ci_2[1] - score_ci_2[3]))
summary_df = data.frame(group, N, score_mean, score_median, sd, se, ci)

# EMA_5.5_ts$jit = jitter(EMA_5.5_ts$Interval, amount = .09)     #already created above
x_tick_means = c(.87, 2.13)

Pre_Post_Box_Violin_Mean_CI = ggplot(data = EMA_5.5_ts, aes(y = Mean)) +
  geom_point(data = EMA_5.5_ts %>% filter(Interval == "1"), aes(x = jit), color = "dodgerblue", size = 1,
             alpha = .6) +
  geom_point(data = EMA_5.5_ts %>% filter(Interval == "2"), aes(x = jit), color = "darkorange", size = 1,
             alpha = .6) +
  geom_line(aes(x = jit, group = ID), color = "lightgray", alpha = .05) +
  geom_half_boxplot(
    data = EMA_5.5_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = -.28),
    side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = FALSE, width = .2,
    fill = "dodgerblue") +
  geom_half_boxplot(
    data = EMA_5.5_ts %>% filter(Interval == "2"), aes(x = Interval, y = Mean), position = position_nudge(x = .18),
    side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = FALSE, width = .2,
    fill = "darkorange") +
  geom_half_violin(
    data = EMA_5.5_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = -.3),
    side = "l", fill = "dodgerblue") +
  geom_half_violin(
    data = EMA_5.5_ts %>% filter(Interval == "2"),aes(x = Interval, y = Mean), position = position_nudge(x = .3),
    side = "r", fill = "darkorange") +
  geom_point(data = EMA_5.5_ts %>% filter(Interval == "1"), aes(x = Interval, y = score_mean[1]),
             position = position_nudge(x = -.13), color = "dodgerblue", alpha = .6, size = 1.5) +
  geom_errorbar(data = EMA_5.5_ts %>% filter(Interval == "1"), aes(x = Interval, y = score_mean[1],
                                                 ymin = score_mean[1]-ci[1], ymax = score_mean[1]+ci[1]),
                position = position_nudge(-.13), color = "dodgerblue", width = 0.05, size = 0.4, alpha = .6) +
  geom_point(data = EMA_5.5_ts %>% filter(Interval == "2"), aes(x = Interval, y = score_mean[2]),
             position = position_nudge(x = .13), color = "darkorange", alpha = .6, size = 1.5)+
  geom_errorbar(data = EMA_5.5_ts %>% filter(Interval == "2"), aes(x = Interval, y = score_mean[2],
                                                 ymin = score_mean[2]-ci[2], ymax = score_mean[2]+ci[2]), 
                position = position_nudge(.13), color = "darkorange", width = 0.05, size = 0.4, alpha = .6) +
  geom_line(data = summary_df, aes(x = x_tick_means, y = score_mean), color = "gray", size = 1) +
  scale_x_continuous(breaks = c(1,2), labels = c("PRE", "POST"), limits = c(0, 3)) +
  xlab("Interval") + ylab("PHQ-9 Mean Score") +
  #ggtitle("EMA Data (5+5 Timepoints): Individual Pre-Post Means") +
  #theme_classic() +
  theme_bw() +
  coord_cartesian(ylim = c(0, 24))

ggsave("Time Series Dataframes/k20_EMA_5.5_Pre-Post_Box_Violin_Mean+CI.jpg", plot = Pre_Post_Box_Violin_Mean_CI, width = 6, height = 4)
save(Pre_Post_Box_Violin_Mean_CI, file = "Time Series Dataframes/k20_EMA_5.5_Pre_Post_Box_Violin_Mean_CI.RData")
#knitr::include_graphics("Time Series Dataframes/k20_EMA_5.5_Pre-Post_Box_Violin.jpg")
knitr::include_graphics("Time Series Dataframes/k20_EMA_5.5_Pre-Post_Box_Violin_Mean+CI.jpg")


1.1.2 Erweiterte Intervall-Daten (je 30 MZP)

EMA_30.30 %>% 
  select(-(ID1_PRE:ID6_POST)) %>% 
  within(., {ind.pretestSD = round(ind.pretestSD, digits = 2)
            ind.posttestSD = round(ind.posttestSD, digits = 2)}) %>% 
  head() %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE) %>% 
  scroll_box(width = "100%")
ID PRE1_1 PRE1_2 PRE1_3 PRE1_4 PRE1_5 PRE1_6 PRE1_7 PRE1_8 PRE1_9 PRE1_10 PRE1_11 PRE1_12 PRE1_13 PRE1_14 PRE1_15 PRE1_16 PRE1_17 PRE1_18 PRE1_19 PRE1_20 PRE1_21 PRE1_22 PRE1_23 PRE1_24 PRE1_25 PRE1_26 PRE1_27 PRE1_28 PRE1_29 PRE1_30 POST1_1 POST1_2 POST1_3 POST1_4 POST1_5 POST1_6 POST1_7 POST1_8 POST1_9 POST1_10 POST1_11 POST1_12 POST1_13 POST1_14 POST1_15 POST1_16 POST1_17 POST1_18 POST1_19 POST1_20 POST1_21 POST1_22 POST1_23 POST1_24 POST1_25 POST1_26 POST1_27 POST1_28 POST1_29 POST1_30 PRE_Mean POST_Mean MeanDiff ind.pretestSD ind.posttestSD
1 9 8 14 10 17 11 11 10 18 8 7 8 14 15 14 9 8 10 14 17 8 14 14 15 7 11 14 16 11 6 5 2 2 6 3 2 5 3 2 6 4 4 1 6 3 3 4 4 6 1 3 2 2 6 5 3 4 1 4 6 11.6 3.6 8.0 3.44 1.65
2 8 9 11 12 7 11 10 11 9 6 11 9 12 8 7 9 12 11 8 7 11 7 8 9 12 12 9 8 11 7 5 4 5 7 2 6 3 7 4 3 6 4 3 7 3 3 4 7 6 3 6 7 3 4 3 7 2 5 4 5 9.4 4.6 4.8 1.89 1.65
3 11 10 5 7 5 9 10 9 7 3 9 10 9 7 3 5 10 11 7 5 10 7 5 5 11 7 10 9 9 3 18 7 9 5 14 8 3 16 11 15 3 8 15 11 16 12 8 5 19 9 16 8 15 11 3 11 18 5 6 13 7.6 10.6 -3.0 2.54 4.84
4 12 7 14 12 12 10 12 8 12 15 10 10 16 11 10 13 9 11 15 9 10 16 10 11 10 11 10 10 16 10 10 12 6 6 7 12 10 6 6 7 8 11 10 8 4 12 6 6 7 10 11 5 7 7 11 7 10 10 10 4 11.4 8.2 3.2 2.37 2.44
5 12 12 14 8 9 8 9 12 14 12 13 14 10 10 8 14 10 13 8 10 13 11 7 11 13 7 11 13 13 11 1 1 8 13 8 14 9 3 3 2 3 15 5 2 6 10 5 1 2 13 2 15 6 5 3 3 3 2 9 14 11.0 6.2 4.8 2.23 4.70
6 8 15 8 8 8 14 10 10 7 6 11 14 8 6 8 10 10 12 11 4 14 11 6 8 8 14 10 10 7 6 3 4 4 6 11 6 4 4 3 11 4 6 9 1 8 1 6 8 9 4 8 6 4 9 1 10 3 4 8 3 9.4 5.6 3.8 2.85 2.92


Pre-Post-Verläufe für 9 zufällig gezogene Personen

rand = sample(EMA_30.30$ID, 9)

x = tibble(ID = c(rep(rand[1],times=61),
                     rep(rand[2],times=61),
                     rep(rand[3],times=61),
                     rep(rand[4],times=61),
                     rep(rand[5],times=61),
                     rep(rand[6],times=61),
                     rep(rand[7],times=61),
                     rep(rand[8],times=61),
                     rep(rand[9],times=61)),
              MZP = rep(seq(as.Date("2020-01-01"), length.out=61, by="1 day"), times=9),
              Score = c(as.numeric(EMA_30.30[rand[1],pre_30mzp]), NA, as.numeric(EMA_30.30[rand[1],post_30mzp]),
                        as.numeric(EMA_30.30[rand[2],pre_30mzp]), NA, as.numeric(EMA_30.30[rand[2],post_30mzp]),
                        as.numeric(EMA_30.30[rand[3],pre_30mzp]), NA, as.numeric(EMA_30.30[rand[3],post_30mzp]),
                        as.numeric(EMA_30.30[rand[4],pre_30mzp]), NA, as.numeric(EMA_30.30[rand[4],post_30mzp]),
                        as.numeric(EMA_30.30[rand[5],pre_30mzp]), NA, as.numeric(EMA_30.30[rand[5],post_30mzp]),
                        as.numeric(EMA_30.30[rand[6],pre_30mzp]), NA, as.numeric(EMA_30.30[rand[6],post_30mzp]),
                        as.numeric(EMA_30.30[rand[7],pre_30mzp]), NA, as.numeric(EMA_30.30[rand[7],post_30mzp]),
                        as.numeric(EMA_30.30[rand[8],pre_30mzp]), NA, as.numeric(EMA_30.30[rand[8],post_30mzp]),
                        as.numeric(EMA_30.30[rand[9],pre_30mzp]), NA, as.numeric(EMA_30.30[rand[9],post_30mzp])))

x %>%
  group_by(ID) %>% 
  plot_time_series(MZP, Score,
    #.color_var = ID,           # for multiple lines in one plot
    #.color_lab = "ID",
    .facet_ncol = 3,
    .facet_scales = "fixed",
    .interactive = TRUE,
    .facet_collapse = FALSE,
    .smooth = TRUE,
    .smooth_degree = 2,
    .smooth_alpha = 0.5,
    .smooth_size = 0.2
  )
# don´t run this section (code for extremely computation-intense plots that I already stored as .RData and .jpg)
# repeated-measures scatter-boxplot-violin-histograms for individual PRE and POST means
# from van Langen (2020) Open-visualizations tutorial for repeated measures in R

# EMA_30.30
# converting my dataframes to use in the same ggplot structure:
EMA_30.30_ts = EMA_30.30 %>% 
  select(ID, PRE_Mean, POST_Mean) %>% 
  pivot_longer(!ID, names_to = "Interval", values_to = "Mean") %>% 
  mutate(ID = as.factor(ID),
         Interval = rep(c(1,2), times = nrow(EMA_30.30)))

save(EMA_30.30_ts, file = "Time Series Dataframes/k20_EMA_30.30_ts.RData")

###

load("Time Series Dataframes/k20_EMA_30.30_ts.RData")

# Repeated measures with box− and violin plots
EMA_30.30_ts$jit = jitter(EMA_30.30_ts$Interval, amount = .09)

Pre_Post_Box_Violin = ggplot(data = EMA_30.30_ts, aes(y = Mean)) +
  geom_point(data = EMA_30.30_ts %>% filter(Interval == "1"), aes(x = jit), color = "dodgerblue", size = 1,
             alpha = .5) +
  geom_point(data = EMA_30.30_ts %>% filter(Interval == "2"), aes(x = jit), color = "darkorange", size = 1,
             alpha = .5) +
  geom_line(aes(x = jit, group = ID), color = "lightgray", alpha = .05) +
  geom_half_boxplot(
    data = EMA_30.30_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = -.25),
    side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = TRUE, width = .1,
    fill = "dodgerblue", alpha = .5) +
  geom_half_boxplot(
    data = EMA_30.30_ts %>% filter(Interval == "2"), aes(x = Interval, y = Mean), position = position_nudge(x = .15),
    side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = TRUE, width = .1,
    fill = "darkorange", alpha = .5) +
  geom_half_violin(
    data = EMA_30.30_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = 1.3),
    side = "r", fill = "dodgerblue", alpha = .5, trim = FALSE) +
  geom_half_violin(
    data = EMA_30.30_ts %>% filter(Interval == "2"), aes(x = Interval, y = Mean), position = position_nudge(x = .3),
    side = "r", fill = "darkorange", alpha = .5, trim = FALSE) +
  scale_x_continuous(breaks = c(1,2), labels = c("PRE", "POST"), limits = c(0, 3)) +
  xlab("Interval") + ylab("PHQ-9 Mean Score") +
  #ggtitle("EMA Data (30+30 Timepoints): Individual Pre-Post Means") +
  #theme_classic() +
  theme_bw() +
  coord_cartesian(ylim = c(0, 24))

ggsave("Time Series Dataframes/k20_EMA_30.30_Pre-Post_Box_Violin.jpg", plot = Pre_Post_Box_Violin, width = 6, height = 4)
save(Pre_Post_Box_Violin, file = "Time Series Dataframes/k20_EMA_30.30_Pre_Post_Box_Violin.RData")


# Repeated measures with box− and violin plots and means + CIs
score_mean_1 = EMA_30.30_ts %>% filter(Interval == "1") %>% summarise(mean(Mean)) %>% as.numeric()
score_mean_2 = EMA_30.30_ts %>% filter(Interval == "2") %>% summarise(mean(Mean)) %>% as.numeric()
score_median1 = EMA_30.30_ts %>% filter(Interval == "1") %>% summarise(median(Mean)) %>% as.numeric()
score_median2 = EMA_30.30_ts %>% filter(Interval == "2") %>% summarise(median(Mean)) %>% as.numeric()
score_sd_1 = EMA_30.30_ts %>% filter(Interval == "1") %>% summarise(sd(Mean)) %>% as.numeric()
score_sd_2 = EMA_30.30_ts %>% filter(Interval == "2") %>% summarise(sd(Mean)) %>% as.numeric()
score_se_1 = score_sd_1/sqrt(nrow(EMA_30.30))
score_se_2 = score_sd_2/sqrt(nrow(EMA_30.30))
score_ci_1 = EMA_30.30_ts %>% filter(Interval == "1") %>% pull(Mean) %>% CI(., ci = 0.95)
score_ci_2 = EMA_30.30_ts %>% filter(Interval == "2") %>% pull(Mean) %>% CI(., ci = 0.95)
#Create data frame with 2 rows and 7 columns containing the descriptives
group = c("PRE", "POST")
N = c(nrow(EMA_30.30), nrow(EMA_30.30))
score_mean = c(score_mean_1, score_mean_2)
score_median = c(score_median1, score_median2)
sd = c(score_sd_1, score_sd_2)
se = c(score_se_1, score_se_2)
ci = c(as.numeric(score_ci_1[1] - score_ci_1[3]), as.numeric(score_ci_2[1] - score_ci_2[3]))
summary_df = data.frame(group, N, score_mean, score_median, sd, se, ci)

# EMA_30.30_ts$jit = jitter(EMA_30.30_ts$Interval, amount = .09)     #already created above
x_tick_means = c(.87, 2.13)

Pre_Post_Box_Violin_Mean_CI = ggplot(data = EMA_30.30_ts, aes(y = Mean)) +
  geom_point(data = EMA_30.30_ts %>% filter(Interval == "1"), aes(x = jit), color = "dodgerblue", size = 1,
             alpha = .6) +
  geom_point(data = EMA_30.30_ts %>% filter(Interval == "2"), aes(x = jit), color = "darkorange", size = 1,
             alpha = .6) +
  geom_line(aes(x = jit, group = ID), color = "lightgray", alpha = .05) +
  geom_half_boxplot(
    data = EMA_30.30_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = -.28),
    side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = FALSE, width = .2,
    fill = "dodgerblue") +
  geom_half_boxplot(
    data = EMA_30.30_ts %>% filter(Interval == "2"), aes(x = Interval, y = Mean), position = position_nudge(x = .18),
    side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = FALSE, width = .2,
    fill = "darkorange") +
  geom_half_violin(
    data = EMA_30.30_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = -.3),
    side = "l", fill = "dodgerblue") +
  geom_half_violin(
    data = EMA_30.30_ts %>% filter(Interval == "2"),aes(x = Interval, y = Mean), position = position_nudge(x = .3),
    side = "r", fill = "darkorange") +
  geom_point(data = EMA_30.30_ts %>% filter(Interval == "1"), aes(x = Interval, y = score_mean[1]),
             position = position_nudge(x = -.13), color = "dodgerblue", alpha = .6, size = 1.5) +
  geom_errorbar(data = EMA_30.30_ts %>% filter(Interval == "1"), aes(x = Interval, y = score_mean[1],
                                                 ymin = score_mean[1]-ci[1], ymax = score_mean[1]+ci[1]),
                position = position_nudge(-.13), color = "dodgerblue", width = 0.05, size = 0.4, alpha = .6) +
  geom_point(data = EMA_30.30_ts %>% filter(Interval == "2"), aes(x = Interval, y = score_mean[2]),
             position = position_nudge(x = .13), color = "darkorange", alpha = .6, size = 1.5)+
  geom_errorbar(data = EMA_30.30_ts %>% filter(Interval == "2"), aes(x = Interval, y = score_mean[2],
                                                 ymin = score_mean[2]-ci[2], ymax = score_mean[2]+ci[2]), 
                position = position_nudge(.13), color = "darkorange", width = 0.05, size = 0.4, alpha = .6) +
  geom_line(data = summary_df, aes(x = x_tick_means, y = score_mean), color = "gray", size = 1) +
  scale_x_continuous(breaks = c(1,2), labels = c("PRE", "POST"), limits = c(0, 3)) +
  xlab("Interval") + ylab("PHQ-9 Mean Score") +
  #ggtitle("EMA Data (30+30 Timepoints): Individual Pre-Post Means") +
  #theme_classic() +
  theme_bw() +
  coord_cartesian(ylim = c(0, 24))

ggsave("Time Series Dataframes/k20_EMA_30.30_Pre-Post_Box_Violin_Mean+CI.jpg", plot = Pre_Post_Box_Violin_Mean_CI, width = 6, height = 4)
save(Pre_Post_Box_Violin_Mean_CI, file = "Time Series Dataframes/k20_EMA_30.30_Pre_Post_Box_Violin_Mean_CI.RData")
#knitr::include_graphics("Time Series Dataframes/k20_EMA_30.30_Pre-Post_Box_Violin.jpg")
knitr::include_graphics("Time Series Dataframes/k20_EMA_30.30_Pre-Post_Box_Violin_Mean+CI.jpg")


1.1.3 Zufallsauswahl: Random Window (je 5 MZP)

EMA_5.5_Window %>%
  within(., {ind.pretestSD = round(ind.pretestSD, digits = 2)
            ind.posttestSD = round(ind.posttestSD, digits = 2)}) %>% 
  head() %>% 
  kable() %>% 
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE) %>% 
  scroll_box(width = "100%")
ID Pre_MZP1 Pre_MZP2 Pre_MZP3 Pre_MZP4 Pre_MZP5 Post_MZP1 Post_MZP2 Post_MZP3 Post_MZP4 Post_MZP5 PRE1_1 PRE1_2 PRE1_3 PRE1_4 PRE1_5 POST1_1 POST1_2 POST1_3 POST1_4 POST1_5 PRE_Mean POST_Mean MeanDiff ind.pretestSD ind.posttestSD
1 PRE1_1 PRE1_2 PRE1_3 PRE1_4 PRE1_5 POST1_25 POST1_26 POST1_27 POST1_28 POST1_29 9 8 14 10 17 5 3 4 1 4 11.6 3.4 8.2 3.78 1.52
2 PRE1_10 PRE1_11 PRE1_12 PRE1_13 PRE1_14 POST1_4 POST1_5 POST1_6 POST1_7 POST1_8 6 11 9 12 8 7 2 6 3 7 9.2 5.0 4.2 2.39 2.35
3 PRE1_18 PRE1_19 PRE1_20 PRE1_21 PRE1_22 POST1_26 POST1_27 POST1_28 POST1_29 POST1_30 11 7 5 10 7 11 18 5 6 13 8.0 10.6 -2.6 2.45 5.32
4 PRE1_17 PRE1_18 PRE1_19 PRE1_20 PRE1_21 POST1_15 POST1_16 POST1_17 POST1_18 POST1_19 9 11 15 9 10 4 12 6 6 7 10.8 7.0 3.8 2.49 3.00
5 PRE1_24 PRE1_25 PRE1_26 PRE1_27 PRE1_28 POST1_7 POST1_8 POST1_9 POST1_10 POST1_11 11 13 7 11 13 9 3 3 2 3 11.0 4.0 7.0 2.45 2.83
6 PRE1_4 PRE1_5 PRE1_6 PRE1_7 PRE1_8 POST1_25 POST1_26 POST1_27 POST1_28 POST1_29 8 8 14 10 10 1 10 3 4 8 10.0 5.2 4.8 2.45 3.70


Pre-Post-Verläufe für 9 zufällig gezogene Personen

rand = sample(EMA_5.5_Window$ID, 9)

x = tibble(ID = c(rep(rand[1],times=11),
                  rep(rand[2],times=11),
                  rep(rand[3],times=11),
                  rep(rand[4],times=11),
                  rep(rand[5],times=11),
                  rep(rand[6],times=11),
                  rep(rand[7],times=11),
                  rep(rand[8],times=11),
                  rep(rand[9],times=11)),
           MZP = rep(seq(as.Date("2020-01-01"), length.out=11, by="1 day"), times=9),
           Score = c(as.numeric(EMA_5.5_Window[rand[1],pre_5mzp]), NA, as.numeric(EMA_5.5_Window[rand[1],post_5mzp]),
                     as.numeric(EMA_5.5_Window[rand[2],pre_5mzp]), NA, as.numeric(EMA_5.5_Window[rand[2],post_5mzp]),
                     as.numeric(EMA_5.5_Window[rand[3],pre_5mzp]), NA, as.numeric(EMA_5.5_Window[rand[3],post_5mzp]),
                     as.numeric(EMA_5.5_Window[rand[4],pre_5mzp]), NA, as.numeric(EMA_5.5_Window[rand[4],post_5mzp]),
                     as.numeric(EMA_5.5_Window[rand[5],pre_5mzp]), NA, as.numeric(EMA_5.5_Window[rand[5],post_5mzp]),
                     as.numeric(EMA_5.5_Window[rand[6],pre_5mzp]), NA, as.numeric(EMA_5.5_Window[rand[6],post_5mzp]),
                     as.numeric(EMA_5.5_Window[rand[7],pre_5mzp]), NA, as.numeric(EMA_5.5_Window[rand[7],post_5mzp]),
                     as.numeric(EMA_5.5_Window[rand[8],pre_5mzp]), NA, as.numeric(EMA_5.5_Window[rand[8],post_5mzp]),
                     as.numeric(EMA_5.5_Window[rand[9],pre_5mzp]), NA, as.numeric(EMA_5.5_Window[rand[9],post_5mzp])))

x %>%
  group_by(ID) %>% 
  plot_time_series(MZP, Score,
    #.color_var = ID,           # for multiple lines in one plot
    #.color_lab = "ID",
    .facet_ncol = 3,
    .facet_scales = "fixed",
    .interactive = TRUE,
    .facet_collapse = FALSE,
    .smooth = TRUE,
    .smooth_degree = 2,
    .smooth_alpha = 0.5,
    .smooth_size = 0.2
  )
# don´t run this section (code for extremely computation-intense plots that I already stored as .RData and .jpg)
# repeated-measures scatter-boxplot-violin-histograms for individual PRE and POST means
# from van Langen (2020) Open-visualizations tutorial for repeated measures in R

# EMA_5.5_Window
# converting my dataframes to use in the same ggplot structure:
EMA_5.5_Window_ts = EMA_5.5_Window %>% 
  select(ID, PRE_Mean, POST_Mean) %>% 
  pivot_longer(!ID, names_to = "Interval", values_to = "Mean") %>% 
  mutate(ID = as.factor(ID),
         Interval = rep(c(1,2), times = nrow(EMA_5.5_Window)))

save(EMA_5.5_Window_ts, file = "Time Series Dataframes/k20_EMA_5.5_Window_ts.RData")

###

load("Time Series Dataframes/k20_EMA_5.5_Window_ts.RData")

# Repeated measures with box− and violin plots
EMA_5.5_Window_ts$jit = jitter(EMA_5.5_Window_ts$Interval, amount = .09)

Pre_Post_Box_Violin = ggplot(data = EMA_5.5_Window_ts, aes(y = Mean)) +
  geom_point(data = EMA_5.5_Window_ts %>% filter(Interval == "1"), aes(x = jit), color = "dodgerblue", size = 1,
             alpha = .5) +
  geom_point(data = EMA_5.5_Window_ts %>% filter(Interval == "2"), aes(x = jit), color = "darkorange", size = 1,
             alpha = .5) +
  geom_line(aes(x = jit, group = ID), color = "lightgray", alpha = .05) +
  geom_half_boxplot(
    data = EMA_5.5_Window_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = -.25),
    side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = TRUE, width = .1,
    fill = "dodgerblue", alpha = .5) +
  geom_half_boxplot(
    data = EMA_5.5_Window_ts %>% filter(Interval == "2"), aes(x = Interval, y = Mean), position = position_nudge(x = .15),
    side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = TRUE, width = .1,
    fill = "darkorange", alpha = .5) +
  geom_half_violin(
    data = EMA_5.5_Window_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = 1.3),
    side = "r", fill = "dodgerblue", alpha = .5, trim = FALSE) +
  geom_half_violin(
    data = EMA_5.5_Window_ts %>% filter(Interval == "2"), aes(x = Interval, y = Mean), position = position_nudge(x = .3),
    side = "r", fill = "darkorange", alpha = .5, trim = FALSE) +
  scale_x_continuous(breaks = c(1,2), labels = c("PRE", "POST"), limits = c(0, 3)) +
  xlab("Interval") + ylab("PHQ-9 Mean Score") +
  #ggtitle("EMA Data (5+5 Timepoint Random Windows): Individual Pre-Post Means") +
  #theme_classic() +
  theme_bw() +
  coord_cartesian(ylim = c(0, 24))

ggsave("Time Series Dataframes/k20_EMA_5.5_Window_Pre-Post_Box_Violin.jpg", plot = Pre_Post_Box_Violin, width = 6, height = 4)
save(Pre_Post_Box_Violin, file = "Time Series Dataframes/k20_EMA_5.5_Window_Pre_Post_Box_Violin.RData")


# Repeated measures with box− and violin plots and means + CIs
score_mean_1 = EMA_5.5_Window_ts %>% filter(Interval == "1") %>% summarise(mean(Mean)) %>% as.numeric()
score_mean_2 = EMA_5.5_Window_ts %>% filter(Interval == "2") %>% summarise(mean(Mean)) %>% as.numeric()
score_median1 = EMA_5.5_Window_ts %>% filter(Interval == "1") %>% summarise(median(Mean)) %>% as.numeric()
score_median2 = EMA_5.5_Window_ts %>% filter(Interval == "2") %>% summarise(median(Mean)) %>% as.numeric()
score_sd_1 = EMA_5.5_Window_ts %>% filter(Interval == "1") %>% summarise(sd(Mean)) %>% as.numeric()
score_sd_2 = EMA_5.5_Window_ts %>% filter(Interval == "2") %>% summarise(sd(Mean)) %>% as.numeric()
score_se_1 = score_sd_1/sqrt(nrow(EMA_5.5_Window))
score_se_2 = score_sd_2/sqrt(nrow(EMA_5.5_Window))
score_ci_1 = EMA_5.5_Window_ts %>% filter(Interval == "1") %>% pull(Mean) %>% CI(., ci = 0.95)
score_ci_2 = EMA_5.5_Window_ts %>% filter(Interval == "2") %>% pull(Mean) %>% CI(., ci = 0.95)
#Create data frame with 2 rows and 7 columns containing the descriptives
group = c("PRE", "POST")
N = c(nrow(EMA_5.5_Window), nrow(EMA_5.5_Window))
score_mean = c(score_mean_1, score_mean_2)
score_median = c(score_median1, score_median2)
sd = c(score_sd_1, score_sd_2)
se = c(score_se_1, score_se_2)
ci = c(as.numeric(score_ci_1[1] - score_ci_1[3]), as.numeric(score_ci_2[1] - score_ci_2[3]))
summary_df = data.frame(group, N, score_mean, score_median, sd, se, ci)

# EMA_5.5_Window_ts$jit = jitter(EMA_5.5_Window_ts$Interval, amount = .09)     #already created above
x_tick_means = c(.87, 2.13)

Pre_Post_Box_Violin_Mean_CI = ggplot(data = EMA_5.5_Window_ts, aes(y = Mean)) +
  geom_point(data = EMA_5.5_Window_ts %>% filter(Interval == "1"), aes(x = jit), color = "dodgerblue", size = 1,
             alpha = .6) +
  geom_point(data = EMA_5.5_Window_ts %>% filter(Interval == "2"), aes(x = jit), color = "darkorange", size = 1,
             alpha = .6) +
  geom_line(aes(x = jit, group = ID), color = "lightgray", alpha = .05) +
  geom_half_boxplot(
    data = EMA_5.5_Window_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = -.28),
    side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = FALSE, width = .2,
    fill = "dodgerblue") +
  geom_half_boxplot(
    data = EMA_5.5_Window_ts %>% filter(Interval == "2"), aes(x = Interval, y = Mean), position = position_nudge(x = .18),
    side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = FALSE, width = .2,
    fill = "darkorange") +
  geom_half_violin(
    data = EMA_5.5_Window_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = -.3),
    side = "l", fill = "dodgerblue") +
  geom_half_violin(
    data = EMA_5.5_Window_ts %>% filter(Interval == "2"),aes(x = Interval, y = Mean), position = position_nudge(x = .3),
    side = "r", fill = "darkorange") +
  geom_point(data = EMA_5.5_Window_ts %>% filter(Interval == "1"), aes(x = Interval, y = score_mean[1]),
             position = position_nudge(x = -.13), color = "dodgerblue", alpha = .6, size = 1.5) +
  geom_errorbar(data = EMA_5.5_Window_ts %>% filter(Interval == "1"), aes(x = Interval, y = score_mean[1],
                                                 ymin = score_mean[1]-ci[1], ymax = score_mean[1]+ci[1]),
                position = position_nudge(-.13), color = "dodgerblue", width = 0.05, size = 0.4, alpha = .6) +
  geom_point(data = EMA_5.5_Window_ts %>% filter(Interval == "2"), aes(x = Interval, y = score_mean[2]),
             position = position_nudge(x = .13), color = "darkorange", alpha = .6, size = 1.5)+
  geom_errorbar(data = EMA_5.5_Window_ts %>% filter(Interval == "2"), aes(x = Interval, y = score_mean[2],
                                                 ymin = score_mean[2]-ci[2], ymax = score_mean[2]+ci[2]), 
                position = position_nudge(.13), color = "darkorange", width = 0.05, size = 0.4, alpha = .6) +
  geom_line(data = summary_df, aes(x = x_tick_means, y = score_mean), color = "gray", size = 1) +
  scale_x_continuous(breaks = c(1,2), labels = c("PRE", "POST"), limits = c(0, 3)) +
  xlab("Interval") + ylab("PHQ-9 Mean Score") +
  #ggtitle("EMA Data (5+5 Timepoint Random Windows): Individual Pre-Post Means") +
  #theme_classic() +
  theme_bw() +
  coord_cartesian(ylim = c(0, 24))

ggsave("Time Series Dataframes/k20_EMA_5.5_Window_Pre-Post_Box_Violin_Mean+CI.jpg", plot = Pre_Post_Box_Violin_Mean_CI, width = 6, height = 4)
save(Pre_Post_Box_Violin_Mean_CI, file = "Time Series Dataframes/k20_EMA_5.5_Window_Pre_Post_Box_Violin_Mean_CI.RData")
#knitr::include_graphics("Time Series Dataframes/k20_EMA_5.5_Window_Pre-Post_Box_Violin.jpg")
knitr::include_graphics("Time Series Dataframes/k20_EMA_5.5_Window_Pre-Post_Box_Violin_Mean+CI.jpg")


1.1.4 Zufallsauswahl: Random Days (je 5 MZP)

EMA_5.5_Days %>%
  within(., {ind.pretestSD = round(ind.pretestSD, digits = 2)
            ind.posttestSD = round(ind.posttestSD, digits = 2)}) %>% 
  head() %>% 
  kable() %>% 
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE) %>% 
  scroll_box(width = "100%")
ID Pre_MZP1 Pre_MZP2 Pre_MZP3 Pre_MZP4 Pre_MZP5 Post_MZP1 Post_MZP2 Post_MZP3 Post_MZP4 Post_MZP5 PRE1_1 PRE1_2 PRE1_3 PRE1_4 PRE1_5 POST1_1 POST1_2 POST1_3 POST1_4 POST1_5 PRE_Mean POST_Mean MeanDiff ind.pretestSD ind.posttestSD
1 PRE1_1 PRE1_5 PRE1_10 PRE1_17 PRE1_25 POST1_4 POST1_15 POST1_17 POST1_18 POST1_26 9 17 8 8 7 6 3 4 4 3 9.8 4.0 5.8 4.09 1.22
2 PRE1_4 PRE1_5 PRE1_7 PRE1_24 PRE1_25 POST1_14 POST1_15 POST1_18 POST1_20 POST1_26 12 7 10 9 12 7 3 7 3 7 10.0 5.4 4.6 2.12 2.19
3 PRE1_3 PRE1_4 PRE1_9 PRE1_25 PRE1_27 POST1_2 POST1_5 POST1_13 POST1_20 POST1_30 5 7 7 11 10 7 14 15 9 13 8.0 11.6 -3.6 2.45 3.44
4 PRE1_1 PRE1_3 PRE1_8 PRE1_26 PRE1_28 POST1_10 POST1_11 POST1_15 POST1_22 POST1_24 12 14 8 11 10 7 8 4 5 7 11.0 6.2 4.8 2.24 1.64
5 PRE1_4 PRE1_8 PRE1_22 PRE1_26 PRE1_28 POST1_4 POST1_5 POST1_13 POST1_18 POST1_28 8 12 11 7 13 13 8 5 1 2 10.2 5.8 4.4 2.59 4.87
6 PRE1_2 PRE1_3 PRE1_18 PRE1_24 PRE1_29 POST1_17 POST1_18 POST1_21 POST1_23 POST1_26 15 8 12 8 7 6 8 8 4 10 10.0 7.2 2.8 3.39 2.28


Pre-Post-Verläufe für 9 zufällig gezogene Personen

rand = sample(EMA_5.5_Days$ID, 9)

x = tibble(ID = c(rep(rand[1],times=11),
                  rep(rand[2],times=11),
                  rep(rand[3],times=11),
                  rep(rand[4],times=11),
                  rep(rand[5],times=11),
                  rep(rand[6],times=11),
                  rep(rand[7],times=11),
                  rep(rand[8],times=11),
                  rep(rand[9],times=11)),
           MZP = rep(seq(as.Date("2020-01-01"), length.out=11, by="1 day"), times=9),
           Score = c(as.numeric(EMA_5.5_Days[rand[1],pre_5mzp]), NA, as.numeric(EMA_5.5_Days[rand[1],post_5mzp]),
                     as.numeric(EMA_5.5_Days[rand[2],pre_5mzp]), NA, as.numeric(EMA_5.5_Days[rand[2],post_5mzp]),
                     as.numeric(EMA_5.5_Days[rand[3],pre_5mzp]), NA, as.numeric(EMA_5.5_Days[rand[3],post_5mzp]),
                     as.numeric(EMA_5.5_Days[rand[4],pre_5mzp]), NA, as.numeric(EMA_5.5_Days[rand[4],post_5mzp]),
                     as.numeric(EMA_5.5_Days[rand[5],pre_5mzp]), NA, as.numeric(EMA_5.5_Days[rand[5],post_5mzp]),
                     as.numeric(EMA_5.5_Days[rand[6],pre_5mzp]), NA, as.numeric(EMA_5.5_Days[rand[6],post_5mzp]),
                     as.numeric(EMA_5.5_Days[rand[7],pre_5mzp]), NA, as.numeric(EMA_5.5_Days[rand[7],post_5mzp]),
                     as.numeric(EMA_5.5_Days[rand[8],pre_5mzp]), NA, as.numeric(EMA_5.5_Days[rand[8],post_5mzp]),
                     as.numeric(EMA_5.5_Days[rand[9],pre_5mzp]), NA, as.numeric(EMA_5.5_Days[rand[9],post_5mzp])))

x %>%
  group_by(ID) %>% 
  plot_time_series(MZP, Score,
    #.color_var = ID,           # for multiple lines in one plot
    #.color_lab = "ID",
    .facet_ncol = 3,
    .facet_scales = "fixed",
    .interactive = TRUE,
    .facet_collapse = FALSE,
    .smooth = TRUE,
    .smooth_degree = 2,
    .smooth_alpha = 0.5,
    .smooth_size = 0.2
  )
# don´t run this section (code for extremely computation-intense plots that I already stored as .RData and .jpg)
# repeated-measures scatter-boxplot-violin-histograms for individual PRE and POST means
# from van Langen (2020) Open-visualizations tutorial for repeated measures in R

# EMA_5.5_Days
# converting my dataframes to use in the same ggplot structure:
EMA_5.5_Days_ts = EMA_5.5_Days %>% 
  select(ID, PRE_Mean, POST_Mean) %>% 
  pivot_longer(!ID, names_to = "Interval", values_to = "Mean") %>% 
  mutate(ID = as.factor(ID),
         Interval = rep(c(1,2), times = nrow(EMA_5.5_Days)))

save(EMA_5.5_Days_ts, file = "Time Series Dataframes/k20_EMA_5.5_Days_ts.RData")

###

load("Time Series Dataframes/k20_EMA_5.5_Days_ts.RData")

# Repeated measures with box− and violin plots
EMA_5.5_Days_ts$jit = jitter(EMA_5.5_Days_ts$Interval, amount = .09)

Pre_Post_Box_Violin = ggplot(data = EMA_5.5_Days_ts, aes(y = Mean)) +
  geom_point(data = EMA_5.5_Days_ts %>% filter(Interval == "1"), aes(x = jit), color = "dodgerblue", size = 1,
             alpha = .5) +
  geom_point(data = EMA_5.5_Days_ts %>% filter(Interval == "2"), aes(x = jit), color = "darkorange", size = 1,
             alpha = .5) +
  geom_line(aes(x = jit, group = ID), color = "lightgray", alpha = .05) +
  geom_half_boxplot(
    data = EMA_5.5_Days_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = -.25),
    side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = TRUE, width = .1,
    fill = "dodgerblue", alpha = .5) +
  geom_half_boxplot(
    data = EMA_5.5_Days_ts %>% filter(Interval == "2"), aes(x = Interval, y = Mean), position = position_nudge(x = .15),
    side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = TRUE, width = .1,
    fill = "darkorange", alpha = .5) +
  geom_half_violin(
    data = EMA_5.5_Days_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = 1.3),
    side = "r", fill = "dodgerblue", alpha = .5, trim = FALSE) +
  geom_half_violin(
    data = EMA_5.5_Days_ts %>% filter(Interval == "2"), aes(x = Interval, y = Mean), position = position_nudge(x = .3),
    side = "r", fill = "darkorange", alpha = .5, trim = FALSE) +
  scale_x_continuous(breaks = c(1,2), labels = c("PRE", "POST"), limits = c(0, 3)) +
  xlab("Interval") + ylab("PHQ-9 Mean Score") +
  #ggtitle("EMA Data (5+5 Timepoint Random Days): Individual Pre-Post Means") +
  #theme_classic() +
  theme_bw() +
  coord_cartesian(ylim = c(0, 24))

ggsave("Time Series Dataframes/k20_EMA_5.5_Days_Pre-Post_Box_Violin.jpg", plot = Pre_Post_Box_Violin, width = 6, height = 4)
save(Pre_Post_Box_Violin, file = "Time Series Dataframes/k20_EMA_5.5_Days_Pre_Post_Box_Violin.RData")


# Repeated measures with box− and violin plots and means + CIs
score_mean_1 = EMA_5.5_Days_ts %>% filter(Interval == "1") %>% summarise(mean(Mean)) %>% as.numeric()
score_mean_2 = EMA_5.5_Days_ts %>% filter(Interval == "2") %>% summarise(mean(Mean)) %>% as.numeric()
score_median1 = EMA_5.5_Days_ts %>% filter(Interval == "1") %>% summarise(median(Mean)) %>% as.numeric()
score_median2 = EMA_5.5_Days_ts %>% filter(Interval == "2") %>% summarise(median(Mean)) %>% as.numeric()
score_sd_1 = EMA_5.5_Days_ts %>% filter(Interval == "1") %>% summarise(sd(Mean)) %>% as.numeric()
score_sd_2 = EMA_5.5_Days_ts %>% filter(Interval == "2") %>% summarise(sd(Mean)) %>% as.numeric()
score_se_1 = score_sd_1/sqrt(nrow(EMA_5.5_Days))
score_se_2 = score_sd_2/sqrt(nrow(EMA_5.5_Days))
score_ci_1 = EMA_5.5_Days_ts %>% filter(Interval == "1") %>% pull(Mean) %>% CI(., ci = 0.95)
score_ci_2 = EMA_5.5_Days_ts %>% filter(Interval == "2") %>% pull(Mean) %>% CI(., ci = 0.95)
#Create data frame with 2 rows and 7 columns containing the descriptives
group = c("PRE", "POST")
N = c(nrow(EMA_5.5_Days), nrow(EMA_5.5_Days))
score_mean = c(score_mean_1, score_mean_2)
score_median = c(score_median1, score_median2)
sd = c(score_sd_1, score_sd_2)
se = c(score_se_1, score_se_2)
ci = c(as.numeric(score_ci_1[1] - score_ci_1[3]), as.numeric(score_ci_2[1] - score_ci_2[3]))
summary_df = data.frame(group, N, score_mean, score_median, sd, se, ci)

# EMA_5.5_Days_ts$jit = jitter(EMA_5.5_Days_ts$Interval, amount = .09)     #already created above
x_tick_means = c(.87, 2.13)

Pre_Post_Box_Violin_Mean_CI = ggplot(data = EMA_5.5_Days_ts, aes(y = Mean)) +
  geom_point(data = EMA_5.5_Days_ts %>% filter(Interval == "1"), aes(x = jit), color = "dodgerblue", size = 1,
             alpha = .6) +
  geom_point(data = EMA_5.5_Days_ts %>% filter(Interval == "2"), aes(x = jit), color = "darkorange", size = 1,
             alpha = .6) +
  geom_line(aes(x = jit, group = ID), color = "lightgray", alpha = .05) +
  geom_half_boxplot(
    data = EMA_5.5_Days_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = -.28),
    side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = FALSE, width = .2,
    fill = "dodgerblue") +
  geom_half_boxplot(
    data = EMA_5.5_Days_ts %>% filter(Interval == "2"), aes(x = Interval, y = Mean), position = position_nudge(x = .18),
    side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = FALSE, width = .2,
    fill = "darkorange") +
  geom_half_violin(
    data = EMA_5.5_Days_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = -.3),
    side = "l", fill = "dodgerblue") +
  geom_half_violin(
    data = EMA_5.5_Days_ts %>% filter(Interval == "2"),aes(x = Interval, y = Mean), position = position_nudge(x = .3),
    side = "r", fill = "darkorange") +
  geom_point(data = EMA_5.5_Days_ts %>% filter(Interval == "1"), aes(x = Interval, y = score_mean[1]),
             position = position_nudge(x = -.13), color = "dodgerblue", alpha = .6, size = 1.5) +
  geom_errorbar(data = EMA_5.5_Days_ts %>% filter(Interval == "1"), aes(x = Interval, y = score_mean[1],
                                                 ymin = score_mean[1]-ci[1], ymax = score_mean[1]+ci[1]),
                position = position_nudge(-.13), color = "dodgerblue", width = 0.05, size = 0.4, alpha = .6) +
  geom_point(data = EMA_5.5_Days_ts %>% filter(Interval == "2"), aes(x = Interval, y = score_mean[2]),
             position = position_nudge(x = .13), color = "darkorange", alpha = .6, size = 1.5)+
  geom_errorbar(data = EMA_5.5_Days_ts %>% filter(Interval == "2"), aes(x = Interval, y = score_mean[2],
                                                 ymin = score_mean[2]-ci[2], ymax = score_mean[2]+ci[2]), 
                position = position_nudge(.13), color = "darkorange", width = 0.05, size = 0.4, alpha = .6) +
  geom_line(data = summary_df, aes(x = x_tick_means, y = score_mean), color = "gray", size = 1) +
  scale_x_continuous(breaks = c(1,2), labels = c("PRE", "POST"), limits = c(0, 3)) +
  xlab("Interval") + ylab("PHQ-9 Mean Score") +
  #ggtitle("EMA Data (5+5 Timepoint Random Days): Individual Pre-Post Means") +
  #theme_classic() +
  theme_bw() +
  coord_cartesian(ylim = c(0, 24))

ggsave("Time Series Dataframes/k20_EMA_5.5_Days_Pre-Post_Box_Violin_Mean+CI.jpg", plot = Pre_Post_Box_Violin_Mean_CI, width = 6, height = 4)
save(Pre_Post_Box_Violin_Mean_CI, file = "Time Series Dataframes/k20_EMA_5.5_Days_Pre_Post_Box_Violin_Mean_CI.RData")
#knitr::include_graphics("Time Series Dataframes/k20_EMA_5.5_Days_Pre-Post_Box_Violin.jpg")
knitr::include_graphics("Time Series Dataframes/k20_EMA_5.5_Days_Pre-Post_Box_Violin_Mean+CI.jpg")


1.2 Deskriptive Statistiken der Datensets

tibble(Descriptives = c("mean_PRE_Mean","mean_POST_Mean","mean_MeanDiff","mean_ind.pretestSD","mean_ind.posttestSD"),
       EMA_5.5 = round(c(mean(EMA_5.5$PRE_Mean),mean(EMA_5.5$POST_Mean),mean(EMA_5.5$MeanDiff),
                        mean(EMA_5.5$ind.pretestSD),mean(EMA_5.5$ind.posttestSD)), digits = 3),
       EMA_30.30 = round(c(mean(EMA_30.30$PRE_Mean),mean(EMA_30.30$POST_Mean),mean(EMA_30.30$MeanDiff),
                          mean(EMA_30.30$ind.pretestSD),mean(EMA_30.30$ind.posttestSD)), digits = 3),
       EMA_5.5_Window = round(c(mean(EMA_5.5_Window$PRE_Mean),mean(EMA_5.5_Window$POST_Mean),
                             mean(EMA_5.5_Window$MeanDiff),mean(EMA_5.5_Window$ind.pretestSD),
                             mean(EMA_5.5_Window$ind.posttestSD)), digits = 3),
       EMA_5.5_Days = round(c(mean(EMA_5.5_Days$PRE_Mean),mean(EMA_5.5_Days$POST_Mean),mean(EMA_5.5_Days$MeanDiff),
                           mean(EMA_5.5_Days$ind.pretestSD),mean(EMA_5.5_Days$ind.posttestSD)), digits = 3)) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
Descriptives EMA_5.5 EMA_30.30 EMA_5.5_Window EMA_5.5_Days
mean_PRE_Mean 10.307 10.307 10.320 10.314
mean_POST_Mean 7.116 7.116 7.098 7.113
mean_MeanDiff 3.191 3.191 3.222 3.200
mean_ind.pretestSD 2.756 2.508 2.579 2.417
mean_ind.posttestSD 3.425 3.115 3.182 2.982

Boxplots der Pre- und Post-Mittelwerte

# ein Boxplot mit Pre- und Post-Verteilungen
#temp = tibble(Scores = c(EMA_5.5$PRE_Mean, EMA_5.5$POST_Mean, EMA_30.30$PRE_Mean, EMA_30.30$POST_Mean, 
#                         EMA_5.5_Window$PRE_Mean, EMA_5.5_Window$POST_Mean, EMA_5.5_Days$PRE_Mean, EMA_5.5_Days$POST_Mean),
#              Datasets = rep(as_factor(c("EMA_5.5", "EMA_30.30", "EMA_5.5_Window", "EMA_5.5_Days")), each = 2*length(EMA_5.5$PRE_Mean)),
#              Assessment = rep(as_factor(c("PRE", "POST", "PRE", "POST", "PRE", "POST", "PRE", "POST")), each = length(EMA_5.5$PRE_Mean)))#<<

temp = tibble(Scores = c(EMA_30.30$PRE_Mean, EMA_30.30$POST_Mean, EMA_5.5_Window$PRE_Mean, EMA_5.5_Window$POST_Mean, 
                         EMA_5.5_Days$PRE_Mean, EMA_5.5_Days$POST_Mean),
              Datasets = rep(as_factor(c("EMA_30.30", "EMA_5.5_Window", "EMA_5.5_Days")), each = 2*length(EMA_30.30$PRE_Mean)),
              Assessment = rep(as_factor(c("PRE", "POST", "PRE", "POST", "PRE", "POST")), each = length(EMA_30.30$PRE_Mean)))#<<

ggplot(temp, aes(x = Datasets, y = Scores, fill = Assessment)) + 
  geom_boxplot() + 
  ylim(0, 27) +
  xlab("Dataset") +
  ylab("PHQ-9 Interval Means")#<<

#ggsave("Plots/k20_EMA-Datasets_Pre-Post_Boxplots_mit_EMA_5.5.jpg", width = 6, height = 4)#<<
#ggsave("Plots/k20_EMA-Datasets_Pre-Post_Boxplots.jpg", width = 6, height = 4)#<<

Prozentuale Überlappung der Pre-Mittelwerte

# Overlap-Plots zum Vergleich
final.plot(list(EMA_5.5_PRE_Mean = EMA_5.5$PRE_Mean, EMA_30.30_PRE_Mean = EMA_30.30$PRE_Mean), 
           overlap(list(EMA_5.5_PRE_Mean = EMA_5.5$PRE_Mean, EMA_30.30_PRE_Mean = EMA_30.30$PRE_Mean))$OV)

final.plot(list(EMA_5.5_PRE_Mean = EMA_5.5$PRE_Mean, EMA_5.5_Window_PRE_Mean = EMA_5.5_Window$PRE_Mean), 
           overlap(list(EMA_5.5_PRE_Mean = EMA_5.5$PRE_Mean, EMA_5.5_Window_PRE_Mean =
                          EMA_5.5_Window$PRE_Mean))$OV)

final.plot(list(EMA_5.5_PRE_Mean = EMA_5.5$PRE_Mean, EMA_5.5_Days_PRE_Mean = EMA_5.5_Days$PRE_Mean), 
           overlap(list(EMA_5.5_PRE_Mean = EMA_5.5$PRE_Mean, EMA_5.5_Days_PRE_Mean =
                          EMA_5.5_Days$PRE_Mean))$OV)

Prozentuale Überlappung der Post-Mittelwerte

# Overlap-Plots zum Vergleich
final.plot(list(EMA_5.5_POST_Mean = EMA_5.5$POST_Mean, EMA_30MZP_POST_Mean = EMA_30.30$POST_Mean), 
           overlap(list(EMA_5.5_POST_Mean = EMA_5.5$POST_Mean, EMA_30MZP_POST_Mean =
                          EMA_30.30$POST_Mean))$OV)

final.plot(list(EMA_5.5_POST_Mean = EMA_5.5$POST_Mean, EMA_Window_POST_Mean = EMA_5.5_Window$POST_Mean), 
           overlap(list(EMA_5.5_POST_Mean = EMA_5.5$POST_Mean, EMA_Window_POST_Mean =
                          EMA_5.5_Window$POST_Mean))$OV)

final.plot(list(EMA_5.5_POST_Mean = EMA_5.5$POST_Mean, EMA_Days_POST_Mean = EMA_5.5_Days$POST_Mean), 
           overlap(list(EMA_5.5_POST_Mean = EMA_5.5$POST_Mean, EMA_Days_POST_Mean = EMA_5.5_Days$POST_Mean))$OV)


1.3 Reliabilitäten und Inter-Item-Korrelationen

1.3.1 EMA_5.5 (je 5 MZP)

# Korrelationsmatrix von PRE- und POST-MZP:
EMA_5.5_KorMat = cor(EMA_5.5[, c(pre_5mzp, post_5mzp)]) %>% 
  round(., digits = 2)

# durchschnittliche paarweise Korrelation zwischen aufeinanderfolgenden MZP (beachte: ohne Fisher-Z-Transformation):
pre_inter_item_rtt = 0L
for (i in 1:4) {
  pre_inter_item_rtt = pre_inter_item_rtt + FisherZ(EMA_5.5_KorMat[i,i+1])
}
pre_inter_item_rtt = FisherZInv(pre_inter_item_rtt / 4)

post_inter_item_rtt = 0L
for (i in 5:9) {
  post_inter_item_rtt = post_inter_item_rtt + FisherZ(EMA_5.5_KorMat[i,i+1])
}
post_inter_item_rtt = FisherZInv(post_inter_item_rtt / 4)


for (i in 1:9) {
  EMA_5.5_KorMat[i, i+1] = cell_spec(EMA_5.5_KorMat[i, i+1], "html", bold = TRUE)
}

rownames(EMA_5.5_KorMat) = cell_spec(rownames(EMA_5.5_KorMat), "html", bold = TRUE)

EMA_5.5_KorMat %>%
  kable(., format = "html", escape = FALSE) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE, fixed_thead = T)
PRE1_1 PRE1_2 PRE1_3 PRE1_4 PRE1_5 POST1_1 POST1_2 POST1_3 POST1_4 POST1_5
PRE1_1 1 0.32 0.1 0.04 0.02 0.16 0.05 0.02 0.01 0.01
PRE1_2 0.32 1 0.32 0.12 0.05 0.05 0.01 0 0 0
PRE1_3 0.1 0.32 1 0.32 0.12 0 0 0.01 0.01 0
PRE1_4 0.04 0.12 0.32 1 0.32 0.01 0 0.02 0.01 0.02
PRE1_5 0.02 0.05 0.12 0.32 1 0 -0.01 0.01 0 0.02
POST1_1 0.16 0.05 0 0.01 0 1 0.32 0.1 0.04 0.01
POST1_2 0.05 0.01 0 0 -0.01 0.32 1 0.31 0.12 0.03
POST1_3 0.02 0 0.01 0.02 0.01 0.1 0.31 1 0.32 0.11
POST1_4 0.01 0 0.01 0.01 0 0.04 0.12 0.32 1 0.32
POST1_5 0.01 0 0 0.02 0.02 0.01 0.03 0.11 0.32 1
# mittleres Cronbach´s Alpha zwischen Pre-MZP und Post-MZP:
PRE_alpha = CronbachAlpha(EMA_5.5[pre_5mzp])
POST_alpha = CronbachAlpha(EMA_5.5[post_5mzp])
EMA_5.5_Alpha = FisherZInv(mean(c(FisherZ(PRE_alpha), FisherZ(POST_alpha))))

Korrelation zwischen den Pre- und Post-Intervall-Mittelwerten = 0.047.
Durchschnittliche paarweise Korrelation zwischen aufeinanderfolgenden Pre-MZP (Fisher-Z-transformiert): r = 0.32.
Durchschnittliche paarweise Korrelation zwischen aufeinanderfolgenden Post-MZP (Fisher-Z-transformiert): r = 0.32.
Mittleres Cronbach´s Alpha zwischen Pre-MZP und Post-MZP = 0.509.


1.3.2 EMA_30.30 (je 30 MZP)

# Korrelationsmatrix von PRE- und POST-MZP:
EMA_30.30_KorMat = cor(EMA_30.30[, c(pre_30mzp, post_30mzp)]) %>% 
  round(., digits = 2)

# durchschnittliche paarweise Korrelation zwischen aufeinanderfolgenden MZP (beachte: ohne Fisher-Z-Transformation):
pre_inter_item_rtt = 0L
for (i in 1:29) {
  pre_inter_item_rtt = pre_inter_item_rtt + FisherZ(EMA_30.30_KorMat[i,i+1])
}
pre_inter_item_rtt = FisherZInv(pre_inter_item_rtt / 29)

post_inter_item_rtt = 0L
for (i in 31:59) {
  post_inter_item_rtt = post_inter_item_rtt + FisherZ(EMA_30.30_KorMat[i,i+1])
}
post_inter_item_rtt = FisherZInv(post_inter_item_rtt / 29)


for (i in 1:59) {
  EMA_30.30_KorMat[i, i+1] = cell_spec(EMA_30.30_KorMat[i, i+1], "html", bold = TRUE)
}

rownames(EMA_30.30_KorMat) = cell_spec(rownames(EMA_30.30_KorMat), "html", bold = TRUE)

EMA_30.30_KorMat %>%
  kable(., format = "html", escape = FALSE) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE, fixed_thead = T) %>%
  scroll_box(height = "800px")
PRE1_1 PRE1_2 PRE1_3 PRE1_4 PRE1_5 PRE1_6 PRE1_7 PRE1_8 PRE1_9 PRE1_10 PRE1_11 PRE1_12 PRE1_13 PRE1_14 PRE1_15 PRE1_16 PRE1_17 PRE1_18 PRE1_19 PRE1_20 PRE1_21 PRE1_22 PRE1_23 PRE1_24 PRE1_25 PRE1_26 PRE1_27 PRE1_28 PRE1_29 PRE1_30 POST1_1 POST1_2 POST1_3 POST1_4 POST1_5 POST1_6 POST1_7 POST1_8 POST1_9 POST1_10 POST1_11 POST1_12 POST1_13 POST1_14 POST1_15 POST1_16 POST1_17 POST1_18 POST1_19 POST1_20 POST1_21 POST1_22 POST1_23 POST1_24 POST1_25 POST1_26 POST1_27 POST1_28 POST1_29 POST1_30
PRE1_1 1 0.32 0.1 0.04 0.02 0.27 0.32 0.32 0.3 0.27 0.27 0.3 0.33 0.32 0.26 0.25 0.33 0.33 0.32 0.24 0.28 0.31 0.31 0.32 0.26 0.26 0.3 0.32 0.32 0.27 0.16 0.05 0.02 0.01 0.01 0.05 0.05 0.05 0.06 0.04 0.05 0.06 0.05 0.04 0.03 0.05 0.06 0.04 0.06 0.03 0.04 0.05 0.05 0.06 0.04 0.05 0.06 0.05 0.04 0.04
PRE1_2 0.32 1 0.32 0.12 0.05 0.33 0.38 0.39 0.38 0.33 0.33 0.39 0.39 0.39 0.31 0.33 0.4 0.42 0.39 0.29 0.33 0.4 0.39 0.38 0.32 0.33 0.38 0.39 0.37 0.33 0.05 0.01 0 0 0 0.03 0 0.01 0.01 0 0.02 0.01 0.01 0.01 0.01 0.01 0.02 0 0.02 0.02 0 0.01 0.01 0.01 0.02 0 0.02 0.03 0 0.01
PRE1_3 0.1 0.32 1 0.32 0.12 0.34 0.39 0.42 0.4 0.32 0.34 0.41 0.41 0.41 0.3 0.34 0.42 0.41 0.39 0.31 0.33 0.43 0.43 0.39 0.3 0.33 0.4 0.43 0.39 0.33 0 0 0.01 0.01 0 0.01 0.01 0.01 -0.01 0 0 0 0.02 0 0.01 0.01 0.01 -0.01 0 0.01 0 0.02 -0.01 0 0 0.02 0 0.01 0 0
PRE1_4 0.04 0.12 0.32 1 0.32 0.32 0.39 0.41 0.38 0.32 0.34 0.39 0.41 0.37 0.3 0.32 0.38 0.39 0.4 0.33 0.3 0.4 0.41 0.4 0.3 0.3 0.37 0.42 0.39 0.34 0.01 0 0.02 0.01 0.02 0 0.02 0.02 0.01 0.01 0 0.02 0.02 0 0.01 0.02 0.03 0 0 0 0.01 0.01 0.01 0 0.01 0 0.02 0.03 0 0
PRE1_5 0.02 0.05 0.12 0.32 1 0.27 0.33 0.34 0.33 0.25 0.28 0.33 0.33 0.32 0.26 0.27 0.31 0.31 0.33 0.3 0.26 0.35 0.32 0.32 0.26 0.28 0.33 0.34 0.31 0.26 0 -0.01 0.01 0 0.02 -0.01 0.02 0 0.01 0 0 0 0 0.02 0 0 0.01 0.01 0.01 0 0.01 0.01 0.02 0 -0.02 0.01 0.01 0.01 0 -0.01
PRE1_6 0.27 0.33 0.34 0.32 0.27 1 0.32 0.12 0.06 0.03 0.28 0.36 0.34 0.31 0.25 0.31 0.29 0.32 0.34 0.27 0.27 0.33 0.33 0.34 0.26 0.29 0.31 0.3 0.32 0.31 0.04 0.02 0 0 0.01 0 0.01 0.02 0.02 0.02 0.02 0.02 0.02 0.01 0.01 0.01 0.02 0.01 0.02 0.02 0.01 0.01 0.03 0.01 0.02 0.02 0.02 0.02 0.01 0
PRE1_7 0.32 0.38 0.39 0.39 0.33 0.32 1 0.33 0.1 0.06 0.33 0.38 0.39 0.41 0.3 0.37 0.39 0.36 0.39 0.3 0.32 0.4 0.42 0.41 0.28 0.3 0.4 0.42 0.38 0.31 0.04 0.01 0.01 0.02 0.01 0.03 0.03 0.02 0 0.01 0.02 0.02 0.03 0.01 0.02 0.02 0.03 0.01 0.01 0.01 0.02 0.01 0.01 0.01 0.03 0.01 0.02 0.03 0.01 0.01
PRE1_8 0.32 0.39 0.42 0.41 0.34 0.12 0.33 1 0.33 0.09 0.36 0.42 0.43 0.39 0.29 0.32 0.43 0.43 0.39 0.32 0.32 0.44 0.42 0.4 0.31 0.28 0.4 0.47 0.4 0.33 0.05 0.01 0.02 0 0 0.03 0.01 0.01 0.02 0.01 0.01 0 0.02 0.02 0.02 0.02 0.02 0.01 0.02 0.01 0.02 0.01 0.02 0.01 0.01 0.02 0.01 0.02 0.02 0.01
PRE1_9 0.3 0.38 0.4 0.38 0.33 0.06 0.1 0.33 1 0.32 0.33 0.36 0.4 0.39 0.31 0.29 0.39 0.39 0.38 0.34 0.31 0.4 0.39 0.37 0.33 0.33 0.39 0.39 0.39 0.3 0.06 0.01 0.03 0.01 0.01 0.02 0.02 0.03 0.03 0 0.02 0.03 0.03 0.02 0.01 0.03 0.03 0.02 0.02 0.02 0.02 0.03 0.02 0.03 0.01 0.02 0.02 0.04 0.01 0.03
PRE1_10 0.27 0.33 0.32 0.32 0.25 0.03 0.06 0.09 0.32 1 0.26 0.31 0.3 0.33 0.29 0.22 0.33 0.36 0.33 0.24 0.29 0.32 0.3 0.3 0.27 0.3 0.27 0.32 0.31 0.29 0.03 0 0.01 0.01 0.01 0 0.02 0.01 0.01 0.01 0 0.03 0.01 0.01 0 0.01 0.02 0 0.01 0.01 -0.01 0.03 0.01 0.02 0 0.01 0.02 0.02 -0.01 0
PRE1_11 0.27 0.33 0.34 0.34 0.28 0.28 0.33 0.36 0.33 0.26 1 0.37 0.13 0.07 0.01 0.3 0.33 0.34 0.35 0.24 0.29 0.35 0.35 0.34 0.24 0.28 0.34 0.31 0.36 0.27 0.04 0.01 0.02 0.01 0.03 0.03 0.02 0.03 0.01 0.01 0.02 0.03 0.03 0.02 0.01 0.02 0.02 0.01 0.02 0.03 0.02 0.03 0.01 0.03 0.02 0.01 0.02 0.04 0.02 0.01
PRE1_12 0.3 0.39 0.41 0.39 0.33 0.36 0.38 0.42 0.36 0.31 0.37 1 0.3 0.11 0.03 0.35 0.41 0.41 0.36 0.3 0.33 0.4 0.4 0.4 0.29 0.34 0.39 0.41 0.38 0.31 0.06 0.01 0 0.02 0 0.02 0.03 0.02 0 0.02 0.03 0.02 0.02 0 0.01 0.02 0.02 0 0.02 0.03 0.01 0.02 0.02 0.03 0.01 0.01 0.03 0.03 0 0.01
PRE1_13 0.33 0.39 0.41 0.41 0.33 0.34 0.39 0.43 0.4 0.3 0.13 0.3 1 0.33 0.1 0.3 0.41 0.41 0.41 0.34 0.33 0.4 0.38 0.41 0.33 0.34 0.37 0.43 0.41 0.32 0.03 0.01 0.01 0.01 0.01 0 0 0.02 0.03 0.01 0.03 0.01 0.01 0.01 0 0.03 0.03 0.01 0 0 0.01 0.02 0.02 0 0.01 0.02 0.02 0.01 0.01 0
PRE1_14 0.32 0.39 0.41 0.37 0.32 0.31 0.41 0.39 0.39 0.33 0.07 0.11 0.33 1 0.3 0.31 0.39 0.41 0.38 0.32 0.29 0.42 0.43 0.39 0.29 0.32 0.38 0.43 0.37 0.32 0.06 0.02 0 0 0.01 0.02 0.02 0.01 0.02 0.01 0.01 0.01 0.03 0.02 0.02 0.01 0.03 0.02 0.02 0 0.01 0.01 0.02 0.02 0.03 0.02 0.01 0.02 0.01 0.03
PRE1_15 0.26 0.31 0.3 0.3 0.26 0.25 0.3 0.29 0.31 0.29 0.01 0.03 0.1 0.3 1 0.25 0.29 0.29 0.34 0.27 0.26 0.32 0.3 0.27 0.29 0.22 0.29 0.32 0.27 0.33 0.03 0 0.03 -0.01 0 0.01 0.02 0.01 0.02 0 -0.01 0.02 0.02 0.02 0.01 0 0.02 0 0.02 0 0.01 0.02 0.02 0 0 0.01 0.01 0.03 0.01 0
PRE1_16 0.25 0.33 0.34 0.32 0.27 0.31 0.37 0.32 0.29 0.22 0.3 0.35 0.3 0.31 0.25 1 0.31 0.11 0.07 0.03 0.24 0.32 0.34 0.34 0.27 0.26 0.31 0.35 0.29 0.3 0.03 0 0 0.01 0 0 0.01 0.01 0.01 0.01 0.02 0.02 0.02 0.01 -0.01 0 0.01 0.01 0.02 0.01 0.01 0.01 0 0.03 0.01 0.01 0.02 0.02 0 0
PRE1_17 0.33 0.4 0.42 0.38 0.31 0.29 0.39 0.43 0.39 0.33 0.33 0.41 0.41 0.39 0.29 0.31 1 0.36 0.13 0.04 0.3 0.4 0.44 0.37 0.32 0.34 0.38 0.42 0.41 0.28 0.07 0.01 0.01 0.02 0 0.02 0.03 0.02 0.01 0.02 0.01 0.03 0.03 0.03 0.01 0.03 0.03 0.01 0.01 0.03 0.01 0.01 0.04 0.02 0.02 0.02 0.02 0.04 0.01 0.01
PRE1_18 0.33 0.42 0.41 0.39 0.31 0.32 0.36 0.43 0.39 0.36 0.34 0.41 0.41 0.41 0.29 0.11 0.36 1 0.31 0.08 0.35 0.41 0.4 0.41 0.29 0.36 0.39 0.38 0.38 0.35 0.06 0.03 0.01 -0.01 0 0.03 0.03 0.01 0.02 0.01 0.01 0.02 0.03 0.02 0.01 0.02 0.02 0.01 0.02 0.02 0.01 0.03 0.01 0.02 0.01 0.01 0.01 0.04 0.01 0.01
PRE1_19 0.32 0.39 0.39 0.4 0.33 0.34 0.39 0.39 0.38 0.33 0.35 0.36 0.41 0.38 0.34 0.07 0.13 0.31 1 0.33 0.35 0.43 0.39 0.37 0.3 0.3 0.38 0.42 0.4 0.35 0.03 0 0.02 0.01 0.03 0.03 0.01 0.03 0.01 0 0.01 0.01 0.02 0.02 0.03 0.02 0.03 0.01 0.03 0.01 0.01 0.03 0.02 0.01 0.02 0.02 0.03 0.03 0.01 0.01
PRE1_20 0.24 0.29 0.31 0.33 0.3 0.27 0.3 0.32 0.34 0.24 0.24 0.3 0.34 0.32 0.27 0.03 0.04 0.08 0.33 1 0.27 0.33 0.29 0.33 0.25 0.24 0.32 0.34 0.31 0.27 0.02 0.01 0.03 0 0.01 0 0.01 0.03 0.02 0 0.02 0.01 0.01 0.01 0.02 0.02 0.03 0 0.01 0 0.02 0.02 0.02 -0.01 0.01 0.02 0.01 0.01 0.01 0.01
PRE1_21 0.28 0.33 0.33 0.3 0.26 0.27 0.32 0.32 0.31 0.29 0.29 0.33 0.33 0.29 0.26 0.24 0.3 0.35 0.35 0.27 1 0.33 0.1 0.07 0.01 0.27 0.33 0.3 0.34 0.27 0.04 0.02 0.01 0.01 0 0.01 0.01 0.01 0.03 0.01 0.03 0.02 0.01 0.01 0.01 0.02 0.01 0.01 0.01 0.03 0.01 0.03 0.03 0.01 0 0.02 0.02 0.01 0.01 0.01
PRE1_22 0.31 0.4 0.43 0.4 0.35 0.33 0.4 0.44 0.4 0.32 0.35 0.4 0.4 0.42 0.32 0.32 0.4 0.41 0.43 0.33 0.33 1 0.37 0.15 0.05 0.34 0.39 0.43 0.39 0.34 0.04 0.01 0.01 -0.02 0 0.02 0.02 0.02 0 -0.01 0 0 0.01 0.01 0.02 0 0.03 -0.01 0.01 0.02 0.02 0.01 0.01 0.01 -0.01 0.01 -0.01 0.04 0 0.01
PRE1_23 0.31 0.39 0.43 0.41 0.32 0.33 0.42 0.42 0.39 0.3 0.35 0.4 0.38 0.43 0.3 0.34 0.44 0.4 0.39 0.29 0.1 0.37 1 0.31 0.08 0.31 0.36 0.43 0.43 0.33 0.05 0.01 0.01 0 0.01 0.03 0.01 0.02 0.02 0.01 0.02 0.02 0.02 0.02 0.01 0.02 0.04 0.02 0.01 0 0.01 0.02 0 0.03 0.02 0.01 0.02 0.03 0.01 0
PRE1_24 0.32 0.38 0.39 0.4 0.32 0.34 0.41 0.4 0.37 0.3 0.34 0.4 0.41 0.39 0.27 0.34 0.37 0.41 0.37 0.33 0.07 0.15 0.31 1 0.29 0.31 0.36 0.45 0.35 0.34 0.04 0.01 0.01 0.02 0.01 0.01 0.02 0.02 0.02 0.02 0.01 0.03 0.04 0.02 -0.01 0.03 0.03 0.02 0.01 0 0.01 0.02 0.01 0.02 0.03 0 0.03 0.03 0.02 0.01
PRE1_25 0.26 0.32 0.3 0.3 0.26 0.26 0.28 0.31 0.33 0.27 0.24 0.29 0.33 0.29 0.29 0.27 0.32 0.29 0.3 0.25 0.01 0.05 0.08 0.29 1 0.27 0.32 0.31 0.27 0.27 0.03 -0.01 0.03 0.02 0.02 0.01 0.03 0.03 0.02 0.01 0.01 0.03 0.03 0.01 0.02 0.01 0.02 0.01 0.04 0.02 0 0.02 0.03 0.01 0.03 0.03 0.03 0.02 0 0.02
PRE1_26 0.26 0.33 0.33 0.3 0.28 0.29 0.3 0.28 0.33 0.3 0.28 0.34 0.34 0.32 0.22 0.26 0.34 0.36 0.3 0.24 0.27 0.34 0.31 0.31 0.27 1 0.29 0.12 0.05 0.03 0.03 0.02 0.01 0 -0.02 0 0.01 0.02 0.01 0 0.01 0.02 0.01 0 0 0 0.02 0 0.01 0.02 0 0.02 0 0 0.01 0 0 0.03 0.01 0
PRE1_27 0.3 0.38 0.4 0.37 0.33 0.31 0.4 0.4 0.39 0.27 0.34 0.39 0.37 0.38 0.29 0.31 0.38 0.39 0.38 0.32 0.33 0.39 0.36 0.36 0.32 0.29 1 0.36 0.09 0.05 0.05 0 0.01 -0.02 0.02 0.02 0.02 0.02 0.01 0 0.01 0.02 0.01 0 0.02 0.01 0.02 0.01 0.02 0.01 0 0.02 0.02 0.02 0.01 0.01 0.02 0.03 0.01 0
PRE1_28 0.32 0.39 0.43 0.42 0.34 0.3 0.42 0.47 0.39 0.32 0.31 0.41 0.43 0.43 0.32 0.35 0.42 0.38 0.42 0.34 0.3 0.43 0.43 0.45 0.31 0.12 0.36 1 0.31 0.12 0.05 0 0 0 0.01 0.02 0.03 0.01 0.01 0.01 0 0.01 0.02 0.02 0.02 0.03 0.01 0 0.01 0.01 0.02 0 0.01 0.02 0.02 0.01 0.02 0.03 0 0.01
PRE1_29 0.32 0.37 0.39 0.39 0.31 0.32 0.38 0.4 0.39 0.31 0.36 0.38 0.41 0.37 0.27 0.29 0.41 0.38 0.4 0.31 0.34 0.39 0.43 0.35 0.27 0.05 0.09 0.31 1 0.35 0.06 0.02 0.01 0.02 0.02 0.04 0.02 0.03 0.03 0.02 0.03 0.03 0.04 0.03 0.01 0.04 0.04 0.01 0.02 0.02 0.02 0.03 0.02 0.02 0.03 0.03 0.04 0.02 0.01 0.03
PRE1_30 0.27 0.33 0.33 0.34 0.26 0.31 0.31 0.33 0.3 0.29 0.27 0.31 0.32 0.32 0.33 0.3 0.28 0.35 0.35 0.27 0.27 0.34 0.33 0.34 0.27 0.03 0.05 0.12 0.35 1 0.03 0.01 0.02 0.02 0 0.01 0.02 0.02 0.03 0.02 0.02 0.01 0.04 0.02 0.01 0.01 0.03 0.02 0.03 0.01 0.02 0.03 0.03 0.01 0 0.02 0.02 0.03 0.01 0.01
POST1_1 0.16 0.05 0 0.01 0 0.04 0.04 0.05 0.06 0.03 0.04 0.06 0.03 0.06 0.03 0.03 0.07 0.06 0.03 0.02 0.04 0.04 0.05 0.04 0.03 0.03 0.05 0.05 0.06 0.03 1 0.32 0.1 0.04 0.01 0.28 0.34 0.31 0.3 0.25 0.26 0.32 0.31 0.32 0.26 0.27 0.31 0.31 0.31 0.27 0.27 0.31 0.31 0.31 0.27 0.26 0.3 0.32 0.31 0.28
POST1_2 0.05 0.01 0 0 -0.01 0.02 0.01 0.01 0.01 0 0.01 0.01 0.01 0.02 0 0 0.01 0.03 0 0.01 0.02 0.01 0.01 0.01 -0.01 0.02 0 0 0.02 0.01 0.32 1 0.31 0.12 0.03 0.32 0.39 0.4 0.38 0.29 0.31 0.38 0.38 0.39 0.32 0.31 0.39 0.38 0.38 0.32 0.32 0.37 0.38 0.39 0.32 0.29 0.36 0.43 0.38 0.32
POST1_3 0.02 0 0.01 0.02 0.01 0 0.01 0.02 0.03 0.01 0.02 0 0.01 0 0.03 0 0.01 0.01 0.02 0.03 0.01 0.01 0.01 0.01 0.03 0.01 0.01 0 0.01 0.02 0.1 0.31 1 0.32 0.11 0.3 0.38 0.42 0.4 0.33 0.3 0.39 0.43 0.4 0.31 0.32 0.4 0.4 0.38 0.33 0.33 0.4 0.4 0.38 0.32 0.31 0.38 0.42 0.39 0.33
POST1_4 0.01 0 0.01 0.01 0 0 0.02 0 0.01 0.01 0.01 0.02 0.01 0 -0.01 0.01 0.02 -0.01 0.01 0 0.01 -0.02 0 0.02 0.02 0 -0.02 0 0.02 0.02 0.04 0.12 0.32 1 0.32 0.33 0.38 0.39 0.39 0.31 0.31 0.38 0.41 0.39 0.32 0.32 0.4 0.4 0.37 0.31 0.31 0.38 0.42 0.37 0.32 0.3 0.38 0.4 0.4 0.32
POST1_5 0.01 0 0 0.02 0.02 0.01 0.01 0 0.01 0.01 0.03 0 0.01 0.01 0 0 0 0 0.03 0.01 0 0 0.01 0.01 0.02 -0.02 0.02 0.01 0.02 0 0.01 0.03 0.11 0.32 1 0.25 0.31 0.32 0.34 0.27 0.27 0.31 0.33 0.31 0.27 0.26 0.31 0.33 0.32 0.27 0.27 0.33 0.34 0.3 0.24 0.25 0.31 0.33 0.31 0.28
POST1_6 0.05 0.03 0.01 0 -0.01 0 0.03 0.03 0.02 0 0.03 0.02 0 0.02 0.01 0 0.02 0.03 0.03 0 0.01 0.02 0.03 0.01 0.01 0 0.02 0.02 0.04 0.01 0.28 0.32 0.3 0.33 0.25 1 0.34 0.12 0.04 -0.01 0.26 0.33 0.31 0.3 0.27 0.26 0.33 0.32 0.31 0.27 0.27 0.34 0.34 0.26 0.27 0.26 0.27 0.33 0.35 0.27
POST1_7 0.05 0 0.01 0.02 0.02 0.01 0.03 0.01 0.02 0.02 0.02 0.03 0 0.02 0.02 0.01 0.03 0.03 0.01 0.01 0.01 0.02 0.01 0.02 0.03 0.01 0.02 0.03 0.02 0.02 0.34 0.39 0.38 0.38 0.31 0.34 1 0.31 0.12 0.04 0.31 0.37 0.37 0.4 0.34 0.3 0.38 0.39 0.4 0.33 0.33 0.37 0.39 0.38 0.33 0.29 0.38 0.42 0.38 0.32
POST1_8 0.05 0.01 0.01 0.02 0 0.02 0.02 0.01 0.03 0.01 0.03 0.02 0.02 0.01 0.01 0.01 0.02 0.01 0.03 0.03 0.01 0.02 0.02 0.02 0.03 0.02 0.02 0.01 0.03 0.02 0.31 0.4 0.42 0.39 0.32 0.12 0.31 1 0.32 0.09 0.3 0.38 0.42 0.42 0.31 0.29 0.4 0.41 0.4 0.34 0.33 0.38 0.39 0.4 0.33 0.29 0.39 0.41 0.39 0.35
POST1_9 0.06 0.01 -0.01 0.01 0.01 0.02 0 0.02 0.03 0.01 0.01 0 0.03 0.02 0.02 0.01 0.01 0.02 0.01 0.02 0.03 0 0.02 0.02 0.02 0.01 0.01 0.01 0.03 0.03 0.3 0.38 0.4 0.39 0.34 0.04 0.12 0.32 1 0.33 0.31 0.39 0.41 0.38 0.32 0.33 0.4 0.39 0.38 0.31 0.32 0.37 0.41 0.4 0.31 0.32 0.39 0.42 0.37 0.32
POST1_10 0.04 0 0 0.01 0 0.02 0.01 0.01 0 0.01 0.01 0.02 0.01 0.01 0 0.01 0.02 0.01 0 0 0.01 -0.01 0.01 0.02 0.01 0 0 0.01 0.02 0.02 0.25 0.29 0.33 0.31 0.27 -0.01 0.04 0.09 0.33 1 0.26 0.3 0.34 0.31 0.24 0.29 0.31 0.3 0.28 0.26 0.25 0.33 0.33 0.31 0.23 0.25 0.3 0.32 0.29 0.28
POST1_11 0.05 0.02 0 0 0 0.02 0.02 0.01 0.02 0 0.02 0.03 0.03 0.01 -0.01 0.02 0.01 0.01 0.01 0.02 0.03 0 0.02 0.01 0.01 0.01 0.01 0 0.03 0.02 0.26 0.31 0.3 0.31 0.27 0.26 0.31 0.3 0.31 0.26 1 0.29 0.1 0.06 0.01 0.29 0.35 0.29 0.27 0.25 0.28 0.3 0.32 0.3 0.26 0.24 0.26 0.34 0.33 0.28
POST1_12 0.06 0.01 0 0.02 0 0.02 0.02 0 0.03 0.03 0.03 0.02 0.01 0.01 0.02 0.02 0.03 0.02 0.01 0.01 0.02 0 0.02 0.03 0.03 0.02 0.02 0.01 0.03 0.01 0.32 0.38 0.39 0.38 0.31 0.33 0.37 0.38 0.39 0.3 0.29 1 0.32 0.12 0.05 0.32 0.38 0.38 0.38 0.31 0.3 0.36 0.37 0.41 0.33 0.3 0.35 0.41 0.38 0.33
POST1_13 0.05 0.01 0.02 0.02 0 0.02 0.03 0.02 0.03 0.01 0.03 0.02 0.01 0.03 0.02 0.02 0.03 0.03 0.02 0.01 0.01 0.01 0.02 0.04 0.03 0.01 0.01 0.02 0.04 0.04 0.31 0.38 0.43 0.41 0.33 0.31 0.37 0.42 0.41 0.34 0.1 0.32 1 0.33 0.12 0.31 0.38 0.42 0.43 0.33 0.3 0.4 0.45 0.38 0.32 0.31 0.4 0.42 0.38 0.35
POST1_14 0.04 0.01 0 0 0.02 0.01 0.01 0.02 0.02 0.01 0.02 0 0.01 0.02 0.02 0.01 0.03 0.02 0.02 0.01 0.01 0.01 0.02 0.02 0.01 0 0 0.02 0.03 0.02 0.32 0.39 0.4 0.39 0.31 0.3 0.4 0.42 0.38 0.31 0.06 0.12 0.33 1 0.28 0.31 0.37 0.4 0.38 0.34 0.32 0.38 0.4 0.38 0.32 0.31 0.41 0.41 0.36 0.31
POST1_15 0.03 0.01 0.01 0.01 0 0.01 0.02 0.02 0.01 0 0.01 0.01 0 0.02 0.01 -0.01 0.01 0.01 0.03 0.02 0.01 0.02 0.01 -0.01 0.02 0 0.02 0.02 0.01 0.01 0.26 0.32 0.31 0.32 0.27 0.27 0.34 0.31 0.32 0.24 0.01 0.05 0.12 0.28 1 0.25 0.33 0.33 0.3 0.27 0.3 0.34 0.31 0.28 0.24 0.24 0.31 0.33 0.33 0.27
POST1_16 0.05 0.01 0.01 0.02 0 0.01 0.02 0.02 0.03 0.01 0.02 0.02 0.03 0.01 0 0 0.03 0.02 0.02 0.02 0.02 0 0.02 0.03 0.01 0 0.01 0.03 0.04 0.01 0.27 0.31 0.32 0.32 0.26 0.26 0.3 0.29 0.33 0.29 0.29 0.32 0.31 0.31 0.25 1 0.32 0.09 0.03 0.02 0.24 0.32 0.32 0.33 0.27 0.28 0.3 0.34 0.3 0.25
POST1_17 0.06 0.02 0.01 0.03 0.01 0.02 0.03 0.02 0.03 0.02 0.02 0.02 0.03 0.03 0.02 0.01 0.03 0.02 0.03 0.03 0.01 0.03 0.04 0.03 0.02 0.02 0.02 0.01 0.04 0.03 0.31 0.39 0.4 0.4 0.31 0.33 0.38 0.4 0.4 0.31 0.35 0.38 0.38 0.37 0.33 0.32 1 0.32 0.11 0.07 0.32 0.41 0.39 0.36 0.32 0.31 0.36 0.42 0.4 0.33
POST1_18 0.04 0 -0.01 0 0.01 0.01 0.01 0.01 0.02 0 0.01 0 0.01 0.02 0 0.01 0.01 0.01 0.01 0 0.01 -0.01 0.02 0.02 0.01 0 0.01 0 0.01 0.02 0.31 0.38 0.4 0.4 0.33 0.32 0.39 0.41 0.39 0.3 0.29 0.38 0.42 0.4 0.33 0.09 0.32 1 0.3 0.1 0.3 0.39 0.41 0.38 0.33 0.28 0.39 0.42 0.42 0.32
POST1_19 0.06 0.02 0 0 0.01 0.02 0.01 0.02 0.02 0.01 0.02 0.02 0 0.02 0.02 0.02 0.01 0.02 0.03 0.01 0.01 0.01 0.01 0.01 0.04 0.01 0.02 0.01 0.02 0.03 0.31 0.38 0.38 0.37 0.32 0.31 0.4 0.4 0.38 0.28 0.27 0.38 0.43 0.38 0.3 0.03 0.11 0.3 1 0.33 0.32 0.35 0.4 0.39 0.3 0.29 0.38 0.38 0.36 0.35
POST1_20 0.03 0.02 0.01 0 0 0.02 0.01 0.01 0.02 0.01 0.03 0.03 0 0 0 0.01 0.03 0.02 0.01 0 0.03 0.02 0 0 0.02 0.02 0.01 0.01 0.02 0.01 0.27 0.32 0.33 0.31 0.27 0.27 0.33 0.34 0.31 0.26 0.25 0.31 0.33 0.34 0.27 0.02 0.07 0.1 0.33 1 0.31 0.32 0.33 0.29 0.25 0.25 0.3 0.36 0.3 0.29
POST1_21 0.04 0 0 0.01 0.01 0.01 0.02 0.02 0.02 -0.01 0.02 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.02 0.01 0.02 0.01 0.01 0 0 0 0.02 0.02 0.02 0.27 0.32 0.33 0.31 0.27 0.27 0.33 0.33 0.32 0.25 0.28 0.3 0.3 0.32 0.3 0.24 0.32 0.3 0.32 0.31 1 0.33 0.14 0.02 0.02 0.25 0.29 0.32 0.34 0.31
POST1_22 0.05 0.01 0.02 0.01 0.01 0.01 0.01 0.01 0.03 0.03 0.03 0.02 0.02 0.01 0.02 0.01 0.01 0.03 0.03 0.02 0.03 0.01 0.02 0.02 0.02 0.02 0.02 0 0.03 0.03 0.31 0.37 0.4 0.38 0.33 0.34 0.37 0.38 0.37 0.33 0.3 0.36 0.4 0.38 0.34 0.32 0.41 0.39 0.35 0.32 0.33 1 0.32 0.11 0.04 0.3 0.34 0.42 0.41 0.32
POST1_23 0.05 0.01 -0.01 0.01 0.02 0.03 0.01 0.02 0.02 0.01 0.01 0.02 0.02 0.02 0.02 0 0.04 0.01 0.02 0.02 0.03 0.01 0 0.01 0.03 0 0.02 0.01 0.02 0.03 0.31 0.38 0.4 0.42 0.34 0.34 0.39 0.39 0.41 0.33 0.32 0.37 0.45 0.4 0.31 0.32 0.39 0.41 0.4 0.33 0.14 0.32 1 0.29 0.09 0.31 0.36 0.44 0.39 0.35
POST1_24 0.06 0.01 0 0 0 0.01 0.01 0.01 0.03 0.02 0.03 0.03 0 0.02 0 0.03 0.02 0.02 0.01 -0.01 0.01 0.01 0.03 0.02 0.01 0 0.02 0.02 0.02 0.01 0.31 0.39 0.38 0.37 0.3 0.26 0.38 0.4 0.4 0.31 0.3 0.41 0.38 0.38 0.28 0.33 0.36 0.38 0.39 0.29 0.02 0.11 0.29 1 0.32 0.31 0.4 0.4 0.33 0.3
POST1_25 0.04 0.02 0 0.01 -0.02 0.02 0.03 0.01 0.01 0 0.02 0.01 0.01 0.03 0 0.01 0.02 0.01 0.02 0.01 0 -0.01 0.02 0.03 0.03 0.01 0.01 0.02 0.03 0 0.27 0.32 0.32 0.32 0.24 0.27 0.33 0.33 0.31 0.23 0.26 0.33 0.32 0.32 0.24 0.27 0.32 0.33 0.3 0.25 0.02 0.04 0.09 0.32 1 0.24 0.33 0.33 0.31 0.26
POST1_26 0.05 0 0.02 0 0.01 0.02 0.01 0.02 0.02 0.01 0.01 0.01 0.02 0.02 0.01 0.01 0.02 0.01 0.02 0.02 0.02 0.01 0.01 0 0.03 0 0.01 0.01 0.03 0.02 0.26 0.29 0.31 0.3 0.25 0.26 0.29 0.29 0.32 0.25 0.24 0.3 0.31 0.31 0.24 0.28 0.31 0.28 0.29 0.25 0.25 0.3 0.31 0.31 0.24 1 0.27 0.12 0.03 0.01
POST1_27 0.06 0.02 0 0.02 0.01 0.02 0.02 0.01 0.02 0.02 0.02 0.03 0.02 0.01 0.01 0.02 0.02 0.01 0.03 0.01 0.02 -0.01 0.02 0.03 0.03 0 0.02 0.02 0.04 0.02 0.3 0.36 0.38 0.38 0.31 0.27 0.38 0.39 0.39 0.3 0.26 0.35 0.4 0.41 0.31 0.3 0.36 0.39 0.38 0.3 0.29 0.34 0.36 0.4 0.33 0.27 1 0.31 0.11 0.03
POST1_28 0.05 0.03 0.01 0.03 0.01 0.02 0.03 0.02 0.04 0.02 0.04 0.03 0.01 0.02 0.03 0.02 0.04 0.04 0.03 0.01 0.01 0.04 0.03 0.03 0.02 0.03 0.03 0.03 0.02 0.03 0.32 0.43 0.42 0.4 0.33 0.33 0.42 0.41 0.42 0.32 0.34 0.41 0.42 0.41 0.33 0.34 0.42 0.42 0.38 0.36 0.32 0.42 0.44 0.4 0.33 0.12 0.31 1 0.33 0.15
POST1_29 0.04 0 0 0 0 0.01 0.01 0.02 0.01 -0.01 0.02 0 0.01 0.01 0.01 0 0.01 0.01 0.01 0.01 0.01 0 0.01 0.02 0 0.01 0.01 0 0.01 0.01 0.31 0.38 0.39 0.4 0.31 0.35 0.38 0.39 0.37 0.29 0.33 0.38 0.38 0.36 0.33 0.3 0.4 0.42 0.36 0.3 0.34 0.41 0.39 0.33 0.31 0.03 0.11 0.33 1 0.32
POST1_30 0.04 0.01 0 0 -0.01 0 0.01 0.01 0.03 0 0.01 0.01 0 0.03 0 0 0.01 0.01 0.01 0.01 0.01 0.01 0 0.01 0.02 0 0 0.01 0.03 0.01 0.28 0.32 0.33 0.32 0.28 0.27 0.32 0.35 0.32 0.28 0.28 0.33 0.35 0.31 0.27 0.25 0.33 0.32 0.35 0.29 0.31 0.32 0.35 0.3 0.26 0.01 0.03 0.15 0.32 1
# mittleres Cronbach´s Alpha zwischen Pre-MZP und Post-MZP:
PRE_alpha = CronbachAlpha(EMA_30.30[pre_30mzp])
POST_alpha = CronbachAlpha(EMA_30.30[post_30mzp])
EMA_30.30_Alpha = FisherZInv(mean(c(FisherZ(PRE_alpha), FisherZ(POST_alpha))))

Korrelation zwischen den Pre- und Post-Intervall-Mittelwerten = 0.047.
Durchschnittliche paarweise Korrelation zwischen aufeinanderfolgenden Pre-MZP (Fisher-Z-transformiert): r = 0.31.
Durchschnittliche paarweise Korrelation zwischen aufeinanderfolgenden Post-MZP (Fisher-Z-transformiert): r = 0.31.
Mittleres Cronbach´s Alpha zwischen Pre-MZP und Post-MZP = 0.932.


1.3.3 EMA_5.5_Window (je 5 MZP)

# Korrelationsmatrix von PRE- und POST-MZP:
EMA_5.5_Window_KorMat = cor(EMA_5.5_Window[, c(pre_5mzp, post_5mzp)]) %>% 
  round(., digits = 2)

# durchschnittliche paarweise Korrelation zwischen aufeinanderfolgenden MZP (beachte: ohne Fisher-Z-Transformation):
pre_inter_item_rtt = 0L
for (i in 1:4) {
  pre_inter_item_rtt = pre_inter_item_rtt + FisherZ(EMA_5.5_Window_KorMat[i,i+1])
}
pre_inter_item_rtt = FisherZInv(pre_inter_item_rtt / 4)

post_inter_item_rtt = 0L
for (i in 5:9) {
  post_inter_item_rtt = post_inter_item_rtt + FisherZ(EMA_5.5_Window_KorMat[i,i+1])
}
post_inter_item_rtt = FisherZInv(post_inter_item_rtt / 4)


for (i in 1:9) {
  EMA_5.5_Window_KorMat[i, i+1] = cell_spec(EMA_5.5_Window_KorMat[i, i+1], "html", bold = TRUE)
}

rownames(EMA_5.5_Window_KorMat) = cell_spec(rownames(EMA_5.5_Window_KorMat), "html", bold = TRUE)

EMA_5.5_Window_KorMat %>%
  kable(., format = "html", escape = FALSE) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE, fixed_thead = T)
PRE1_1 PRE1_2 PRE1_3 PRE1_4 PRE1_5 POST1_1 POST1_2 POST1_3 POST1_4 POST1_5
PRE1_1 1 0.32 0.18 0.24 0.3 0.02 0 0.02 0.03 0.01
PRE1_2 0.32 1 0.3 0.19 0.22 0.03 0.02 0.01 0.02 0.02
PRE1_3 0.18 0.3 1 0.31 0.17 0.02 0.02 0.02 0.02 0.02
PRE1_4 0.24 0.19 0.31 1 0.31 0.01 0.03 0.03 0.01 0.02
PRE1_5 0.3 0.22 0.17 0.31 1 0.03 0.01 0.02 0.01 0.02
POST1_1 0.02 0.03 0.02 0.01 0.03 1 0.3 0.19 0.21 0.26
POST1_2 0 0.02 0.02 0.03 0.01 0.3 1 0.3 0.19 0.19
POST1_3 0.02 0.01 0.02 0.03 0.02 0.19 0.3 1 0.31 0.17
POST1_4 0.03 0.02 0.02 0.01 0.01 0.21 0.19 0.31 1 0.32
POST1_5 0.01 0.02 0.02 0.02 0.02 0.26 0.19 0.17 0.32 1
# mittleres Cronbach´s Alpha zwischen Pre-MZP und Post-MZP:
PRE_alpha = CronbachAlpha(EMA_5.5_Window[pre_5mzp])
POST_alpha = CronbachAlpha(EMA_5.5_Window[post_5mzp])
EMA_5.5_Window_Alpha = FisherZInv(mean(c(FisherZ(PRE_alpha), FisherZ(POST_alpha))))

Korrelation zwischen den Pre- und Post-Intervall-Mittelwerten = 0.045.
Durchschnittliche paarweise Korrelation zwischen aufeinanderfolgenden Pre-MZP (Fisher-Z-transformiert): r = 0.31.
Durchschnittliche paarweise Korrelation zwischen aufeinanderfolgenden Post-MZP (Fisher-Z-transformiert): r = 0.31.
Mittleres Cronbach´s Alpha zwischen Pre-MZP und Post-MZP = 0.623.


1.3.4 EMA_5.5_Days (je 5 MZP)

# Korrelationsmatrix von PRE- und POST-MZP:
EMA_5.5_Days_KorMat = cor(EMA_5.5_Days[, c(pre_5mzp, post_5mzp)]) %>% 
  round(., digits = 2)

# durchschnittliche paarweise Korrelation zwischen aufeinanderfolgenden MZP (beachte: ohne Fisher-Z-Transformation):
pre_inter_item_rtt = 0L
for (i in 1:4) {
  pre_inter_item_rtt = pre_inter_item_rtt + FisherZ(EMA_5.5_Days_KorMat[i,i+1])
}
pre_inter_item_rtt = FisherZInv(pre_inter_item_rtt / 4)

post_inter_item_rtt = 0L
for (i in 5:9) {
  post_inter_item_rtt = post_inter_item_rtt + FisherZ(EMA_5.5_Days_KorMat[i,i+1])
}
post_inter_item_rtt = FisherZInv(post_inter_item_rtt / 4)


for (i in 1:9) {
  EMA_5.5_Days_KorMat[i, i+1] = cell_spec(EMA_5.5_Days_KorMat[i, i+1], "html", bold = TRUE)
}

rownames(EMA_5.5_Days_KorMat) = cell_spec(rownames(EMA_5.5_Days_KorMat), "html", bold = TRUE)

EMA_5.5_Days_KorMat %>%
  kable(., format = "html", escape = FALSE) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE, fixed_thead = T)
PRE1_1 PRE1_2 PRE1_3 PRE1_4 PRE1_5 POST1_1 POST1_2 POST1_3 POST1_4 POST1_5
PRE1_1 1 0.28 0.34 0.36 0.33 0 0.02 0.01 0 0.02
PRE1_2 0.28 1 0.3 0.35 0.35 0 0.02 0.01 0 0.02
PRE1_3 0.34 0.3 1 0.31 0.36 0 0.02 0.01 0.01 0.02
PRE1_4 0.36 0.35 0.31 1 0.28 -0.01 0.01 0 -0.02 -0.01
PRE1_5 0.33 0.35 0.36 0.28 1 0.01 0.01 0.02 0.02 0.01
POST1_1 0 0 0 -0.01 0.01 1 0.28 0.34 0.35 0.33
POST1_2 0.02 0.02 0.02 0.01 0.01 0.28 1 0.3 0.34 0.32
POST1_3 0.01 0.01 0.01 0 0.02 0.34 0.3 1 0.31 0.32
POST1_4 0 0 0.01 -0.02 0.02 0.35 0.34 0.31 1 0.29
POST1_5 0.02 0.02 0.02 -0.01 0.01 0.33 0.32 0.32 0.29 1
# mittleres Cronbach´s Alpha zwischen Pre-MZP und Post-MZP:
PRE_alpha = CronbachAlpha(EMA_5.5_Days[pre_5mzp])
POST_alpha = CronbachAlpha(EMA_5.5_Days[post_5mzp])
EMA_5.5_Days_Alpha = FisherZInv(mean(c(FisherZ(PRE_alpha), FisherZ(POST_alpha))))

Korrelation zwischen den Pre- und Post-Intervall-Mittelwerten = 0.016.
Durchschnittliche paarweise Korrelation zwischen aufeinanderfolgenden Pre-MZP (Fisher-Z-transformiert): r = 0.29.
Durchschnittliche paarweise Korrelation zwischen aufeinanderfolgenden Post-MZP (Fisher-Z-transformiert): r = 0.3.
Mittleres Cronbach´s Alpha zwischen Pre-MZP und Post-MZP = 0.703.


1.4 Pre-Post-Differenz

Verteilungen der Pre-Post-Mittelwerts-Veränderungen

temp = tibble(MeanDiffs = c(EMA_5.5$MeanDiff, EMA_30.30$MeanDiff, EMA_5.5_Window$MeanDiff, EMA_5.5_Days$MeanDiff),
              Datasets = rep(as_factor(c("EMA_5.5", "EMA_30.30", "EMA_5.5_Window", "EMA_5.5_Days")), each = length(EMA_5.5$MeanDiff)))#<<

temp %>%
  ggplot(aes(x = MeanDiffs, fill = Datasets)) +
    geom_histogram(alpha = 0.2, binwidth = 1, position = "identity") +
    labs(x = "PHQ-9 Pre-Post Difference", y = "")#<<

#ggsave("Plots/k20_PP-Datasets_Pre-Post-Diff_Histogram.jpg", width = 6, height = 4)#<<

scatter.hist(EMA_5.5$MeanDiff, EMA_30.30$MeanDiff, xlab = "EMA_5.5$MeanDiff",
  ylab = "EMA_30.30$MeanDiff", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))

scatter.hist(EMA_5.5$MeanDiff, EMA_5.5_Window$MeanDiff, xlab = "EMA_5.5$MeanDiff",
  ylab = "EMA_5.5_Window$MeanDiff", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))

scatter.hist(EMA_5.5$MeanDiff, EMA_5.5_Days$MeanDiff, xlab = "EMA_5.5$MeanDiff",
  ylab = "EMA_5.5_Days$MeanDiff", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))

scatter.hist(EMA_5.5_Window$MeanDiff, EMA_5.5_Days$MeanDiff, xlab = "EMA_5.5_Window$MeanDiff",
  ylab = "EMA_5.5_Days$MeanDiff", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))

Korrelation zwischen den Pre-Post-Differenzen in EMA_5.5 und EMA_30.30 = 1.
Korrelation zwischen den Pre-Post-Differenzen in EMA_5.5_Window und EMA_30.30 = 0.913.
Korrelation zwischen den Pre-Post-Differenzen in EMA_5.5_Days und EMA_30.30 = 0.859.

Prozentuale Überlappung der Pre-Post-Mittelwerts-Veränderungen

# Overlap-Plots zum Vergleich
final.plot(list(EMA_5.5_MeanDiff = EMA_5.5$MeanDiff, EMA_30.30_MeanDiff = EMA_30.30$MeanDiff), 
           overlap(list(EMA_5.5_MeanDiff = EMA_5.5$MeanDiff, EMA_30.30_MeanDiff = EMA_30.30$MeanDiff))$OV)

final.plot(list(EMA_5.5_Window_MeanDiff = EMA_5.5_Window$MeanDiff, EMA_30.30_MeanDiff = EMA_30.30$MeanDiff), 
           overlap(list(EMA_5.5_Window_MeanDiff = EMA_5.5_Window$MeanDiff, EMA_30.30_MeanDiff = EMA_30.30$MeanDiff))$OV)

final.plot(list(EMA_5.5_Days_MeanDiff = EMA_5.5_Days$MeanDiff, EMA_30.30_MeanDiff = EMA_30.30$MeanDiff), 
           overlap(list(EMA_5.5_Days_MeanDiff = EMA_5.5_Days$MeanDiff, EMA_30.30_MeanDiff = EMA_30.30$MeanDiff))$OV)

final.plot(list(EMA_5.5_Window_MeanDiff = EMA_5.5_Window$MeanDiff, EMA_5.5_Days_MeanDiff = EMA_5.5_Days$MeanDiff), 
           overlap(list(EMA_5.5_Window_MeanDiff = EMA_5.5_Window$MeanDiff, EMA_5.5_Days_MeanDiff = EMA_5.5_Days$MeanDiff))$OV)


1.4.1 Cohen´s d

Cohen´s d (mit gepoolten SDs) vom Pre- zum Post-Intervall in EMA_5.5 (je 5 MZP)

\[ d = \frac{\overline{x_{1}} - \overline{x_{2}}} {\sqrt{0.5 \cdot (s_{x}^2 + s_{y}^2)}} \]

\(\overline{x_{1}}\) = mean of subject´s pretest scores, \(\overline{x_{2}}\) = mean of subject´s posttest scores, \(s_{x}\) = individual standard deviation of pretest time points, \(s_{y}\) = individual standard deviation of posttest time points

EMA_5.5$Cohen_d = (EMA_5.5$PRE_Mean - EMA_5.5$POST_Mean) / sqrt(0.5 * (EMA_5.5$ind.pretestSD^2 + EMA_5.5$ind.posttestSD^2))

# Sollen Cohen_d %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#EMA_5.5 = EMA_5.5 %>% 
#  within(., {Cohen_d[Cohen_d %in% c(-Inf,Inf)] = NA})

#hist(EMA_5.5$Cohen_d, col = "lightblue1", main = "EMA_5.5$Cohen_d")

cohen_d_5.5 = (mean(EMA_5.5$PRE_Mean) - mean(EMA_5.5$POST_Mean)) / sqrt(0.5 * (mean(EMA_5.5$ind.pretestSD)^2 +
  mean(EMA_5.5$ind.posttestSD)^2))

final.plot(list(EMA_5.5_PRE_Mean = EMA_5.5$PRE_Mean, EMA_5.5_POST_Mean = EMA_5.5$POST_Mean), 
           overlap(list(EMA_5.5_PRE_Mean = EMA_5.5$PRE_Mean, EMA_5.5_POST_Mean = EMA_5.5$POST_Mean))$OV)

Gepoolte Varianz zwischen Pre- und Post-Intervall-Mittelwerten in EMA_5.5 = 3.007.
Durchschnittliches Cohen´s d zwischen Pre- und Post-Mittelwerten (für jede Person einzeln berechnet) in EMA_5.5 = 1.174.
Durchschnittliches Cohen´s d zwischen Pre- und Post-Mittelwerten in EMA_5.5 = 1.027.


Cohen´s d (mit gepoolten SDs) vom Pre- zum Post-Intervall in den erweiterten Intervall-Daten (je 30 MZP)

EMA_30.30$Cohen_d = (EMA_30.30$PRE_Mean - EMA_30.30$POST_Mean) / sqrt(0.5 * (EMA_30.30$ind.pretestSD^2 + EMA_30.30$ind.posttestSD^2))

# Sollen Cohen_d %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#EMA_30.30 = EMA_30.30 %>% 
#  within(., {Cohen_d[Cohen_d %in% c(-Inf,Inf)] = NA})

#hist(EMA_30.30$Cohen_d, col = "lightblue1", main = "EMA_30.30$Cohen_d")

cohen_d_30.30 = (mean(EMA_30.30$PRE_Mean) - mean(EMA_30.30$POST_Mean)) / sqrt(0.5 * (mean(EMA_30.30$ind.pretestSD)^2 +
  mean(EMA_30.30$ind.posttestSD)^2))

final.plot(list(EMA_30.30_PRE_Mean = EMA_30.30$PRE_Mean, EMA_30.30_POST_Mean = EMA_30.30$POST_Mean), 
           overlap(list(EMA_30.30_PRE_Mean = EMA_30.30$PRE_Mean, EMA_30.30_POST_Mean = EMA_30.30$POST_Mean))$OV)

Gepoolte Varianz zwischen Pre- und Post-Intervall-Mittelwerten in EMA_30.30 = 3.007.
Durchschnittliches Cohen´s d zwischen Pre- und Post-Mittelwerten (für jede Person einzeln berechnet) in EMA_30.30 = 1.291.
Durchschnittliches Cohen´s d zwischen Pre- und Post-Mittelwerten in EMA_30.30 = 1.129.


Cohen´s d (mit gepoolten SDs) vom Pre- zum Post-Intervall in EMA_5.5_Window (je 5 MZP)

EMA_5.5_Window$Cohen_d = (EMA_5.5_Window$PRE_Mean - EMA_5.5_Window$POST_Mean) / sqrt(0.5 * (EMA_5.5_Window$ind.pretestSD^2 + EMA_5.5_Window$ind.posttestSD^2))

# Sollen Cohen_d %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#EMA_5.5_Window = EMA_5.5_Window %>% 
#  within(., {Cohen_d[Cohen_d %in% c(-Inf,Inf)] = NA})

#hist(EMA_5.5_Window$Cohen_d, col = "lightblue1", main = "EMA_5.5_Window$Cohen_d")

cohen_d_5.5_Window = (mean(EMA_5.5_Window$PRE_Mean) - mean(EMA_5.5_Window$POST_Mean)) / sqrt(0.5 * (mean(EMA_5.5_Window$ind.pretestSD)^2 + mean(EMA_5.5_Window$ind.posttestSD)^2))

final.plot(list(EMA_5.5_Window_PRE_Mean = EMA_5.5_Window$PRE_Mean, EMA_5.5_Window_POST_Mean = EMA_5.5_Window$POST_Mean),
    overlap(list(EMA_5.5_Window_PRE_Mean = EMA_5.5_Window$PRE_Mean, EMA_5.5_Window_POST_Mean = EMA_5.5_Window$POST_Mean))$OV)

Gepoolte Varianz zwischen Pre- und Post-Intervall-Mittelwerten in EMA_5.5_Window = 3.256.
Durchschnittliches Cohen´s d zwischen Pre- und Post-Mittelwerten (für jede Person einzeln berechnet) in EMA_5.5_Window = 1.307.
Durchschnittliches Cohen´s d zwischen Pre- und Post-Mittelwerten in EMA_5.5_Window = 1.113.


Cohen´s d (mit gepoolten SDs) vom Pre- zum Post-Intervall in EMA_5.5_Days (je 5 MZP)

EMA_5.5_Days$Cohen_d = (EMA_5.5_Days$PRE_Mean - EMA_5.5_Days$POST_Mean) / sqrt(0.5 * (EMA_5.5_Days$ind.pretestSD^2 + EMA_5.5_Days$ind.posttestSD^2))

# Sollen Cohen_d %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#EMA_5.5_Days = EMA_5.5_Days %>% 
#  within(., {Cohen_d[Cohen_d %in% c(-Inf,Inf)] = NA})

#hist(EMA_5.5_Days$Cohen_d, col = "lightblue1", main = "EMA_5.5_Days$Cohen_d")

cohen_d_5.5_Days = (mean(EMA_5.5_Days$PRE_Mean) - mean(EMA_5.5_Days$POST_Mean)) / sqrt(0.5 * (mean(EMA_5.5_Days$ind.pretestSD)^2 + mean(EMA_5.5_Days$ind.posttestSD)^2))

final.plot(list(EMA_5.5_Days_PRE_Mean = EMA_5.5_Days$PRE_Mean, EMA_5.5_Days_POST_Mean = EMA_5.5_Days$POST_Mean),
    overlap(list(EMA_5.5_Days_PRE_Mean = EMA_5.5_Days$PRE_Mean, EMA_5.5_Days_POST_Mean = EMA_5.5_Days$POST_Mean))$OV)

Gepoolte Varianz zwischen Pre- und Post-Intervall-Mittelwerten in EMA_5.5_Days = 3.513.
Durchschnittliches Cohen´s d zwischen Pre- und Post-Mittelwerten (für jede Person einzeln berechnet) in EMA_5.5_Days = 1.437.
Durchschnittliches Cohen´s d zwischen Pre- und Post-Mittelwerten in EMA_5.5_Days = 1.179.


Ab hier nur noch Vergleiche in EMA_30.30, EMA_5.5_Window und EMA_5.5_Days:


1.5 Klinische PHQ-9-Interpretation

PHQ_Int = tibble(PHQ_Score = c("0-4","5-9","10-14","15-19","20-27"),
       Klassifikation = c(0,1,2,3,4),
       Interpretation = c("Minimal or none","Mild","Moderate","Moderately severe","Severe"))

1.5.1 EMA_30.30

EMA_30.30 = EMA_30.30 %>% 
  mutate(PRE_Mean_klass = case_when(
    PRE_Mean <= 4 ~ 0,
    PRE_Mean > 4 & PRE_Mean < 10 ~ 1,
    PRE_Mean >= 10 & PRE_Mean < 15 ~ 2,
    PRE_Mean >= 15 & PRE_Mean < 20 ~ 3,
    PRE_Mean >= 20 ~ 4,
    TRUE ~ PRE_Mean
  )
)

temp = EMA_30.30 %>% 
  count(PRE_Mean_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

PHQ_Int %>%
  dplyr::rename(PRE_Mean_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
PHQ_Score PRE_Mean_klass Interpretation n Percentage
0-4 0 Minimal or none NA NA
5-9 1 Mild 3283 40.83
10-14 2 Moderate 4732 58.86
15-19 3 Moderately severe 25 0.31
20-27 4 Severe NA NA
EMA_30.30 = EMA_30.30 %>% 
  mutate(POST_Mean_klass = case_when(
    POST_Mean <= 4 ~ 0,
    POST_Mean > 4 & POST_Mean < 10 ~ 1,
    POST_Mean >= 10 & POST_Mean < 15 ~ 2,
    POST_Mean >= 15 & POST_Mean < 20 ~ 3,
    POST_Mean >= 20 ~ 4,
    TRUE ~ POST_Mean
  )
)

temp = EMA_30.30 %>% 
  count(POST_Mean_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

PHQ_Int %>%
  dplyr::rename(POST_Mean_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
PHQ_Score POST_Mean_klass Interpretation n Percentage
0-4 0 Minimal or none 862 10.72
5-9 1 Mild 6126 76.19
10-14 2 Moderate 1052 13.08
15-19 3 Moderately severe NA NA
20-27 4 Severe NA NA
temp = tibble(Classification = c(EMA_30.30$PRE_Mean_klass, EMA_30.30$POST_Mean_klass),
              Assessment = rep(as_factor(c("PRE Interval Mean", "POST Interval Mean")), each = length(EMA_30.30$PRE_Mean_klass)))#<<

temp %>%
  ggplot(aes(x = Classification, fill = Assessment)) +
    geom_histogram(alpha = 0.2, binwidth = 1, position = "identity") +
    labs(x = "PHQ-9 Classification", y = "")#<<

#ggsave("Plots/k20_EMA_30.30_PHQ-Class_Histogram.jpg", width = 6, height = 4)#<<

1.5.2 EMA_5.5_Window

EMA_5.5_Window = EMA_5.5_Window %>% 
  mutate(PRE_Mean_klass = case_when(
    PRE_Mean <= 4 ~ 0,
    PRE_Mean > 4 & PRE_Mean < 10 ~ 1,
    PRE_Mean >= 10 & PRE_Mean < 15 ~ 2,
    PRE_Mean >= 15 & PRE_Mean < 20 ~ 3,
    PRE_Mean >= 20 ~ 4,
    TRUE ~ PRE_Mean
  )
)

temp = EMA_5.5_Window %>% 
  count(PRE_Mean_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

PHQ_Int %>%
  dplyr::rename(PRE_Mean_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
PHQ_Score PRE_Mean_klass Interpretation n Percentage
0-4 0 Minimal or none 3 0.04
5-9 1 Mild 3316 41.24
10-14 2 Moderate 4651 57.85
15-19 3 Moderately severe 70 0.87
20-27 4 Severe NA NA
EMA_5.5_Window = EMA_5.5_Window %>% 
  mutate(POST_Mean_klass = case_when(
    POST_Mean <= 4 ~ 0,
    POST_Mean > 4 & POST_Mean < 10 ~ 1,
    POST_Mean >= 10 & POST_Mean < 15 ~ 2,
    POST_Mean >= 15 & POST_Mean < 20 ~ 3,
    POST_Mean >= 20 ~ 4,
    TRUE ~ POST_Mean
  )
)

temp = EMA_5.5_Window %>% 
  count(POST_Mean_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

PHQ_Int %>%
  dplyr::rename(POST_Mean_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
PHQ_Score POST_Mean_klass Interpretation n Percentage
0-4 0 Minimal or none 983 12.23
5-9 1 Mild 5842 72.66
10-14 2 Moderate 1212 15.07
15-19 3 Moderately severe 3 0.04
20-27 4 Severe NA NA
temp = tibble(Classification = c(EMA_5.5_Window$PRE_Mean_klass, EMA_5.5_Window$POST_Mean_klass),
              Assessment = rep(as_factor(c("PRE Interval Mean", "POST Interval Mean")), each = length(EMA_5.5_Window$PRE_Mean_klass)))#<<

temp %>%
  ggplot(aes(x = Classification, fill = Assessment)) +
    geom_histogram(alpha = 0.2, binwidth = 1, position = "identity") +
    labs(x = "PHQ-9 Classification", y = "")#<<

#ggsave("Plots/k20_EMA_5.5_Window_PHQ-Class_Histogram.jpg", width = 6, height = 4)#<<

1.5.3 EMA_5.5_Days

EMA_5.5_Days = EMA_5.5_Days %>% 
  mutate(PRE_Mean_klass = case_when(
    PRE_Mean <= 4 ~ 0,
    PRE_Mean > 4 & PRE_Mean < 10 ~ 1,
    PRE_Mean >= 10 & PRE_Mean < 15 ~ 2,
    PRE_Mean >= 15 & PRE_Mean < 20 ~ 3,
    PRE_Mean >= 20 ~ 4,
    TRUE ~ PRE_Mean
  )
)

temp = EMA_5.5_Days %>% 
  count(PRE_Mean_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

PHQ_Int %>%
  dplyr::rename(PRE_Mean_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
PHQ_Score PRE_Mean_klass Interpretation n Percentage
0-4 0 Minimal or none 13 0.16
5-9 1 Mild 3388 42.14
10-14 2 Moderate 4506 56.04
15-19 3 Moderately severe 133 1.65
20-27 4 Severe NA NA
EMA_5.5_Days = EMA_5.5_Days %>% 
  mutate(POST_Mean_klass = case_when(
    POST_Mean <= 4 ~ 0,
    POST_Mean > 4 & POST_Mean < 10 ~ 1,
    POST_Mean >= 10 & POST_Mean < 15 ~ 2,
    POST_Mean >= 15 & POST_Mean < 20 ~ 3,
    POST_Mean >= 20 ~ 4,
    TRUE ~ POST_Mean
  )
)

temp = EMA_5.5_Days %>% 
  count(POST_Mean_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

PHQ_Int %>%
  dplyr::rename(POST_Mean_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
PHQ_Score POST_Mean_klass Interpretation n Percentage
0-4 0 Minimal or none 1135 14.12
5-9 1 Mild 5562 69.18
10-14 2 Moderate 1318 16.39
15-19 3 Moderately severe 25 0.31
20-27 4 Severe NA NA
temp = tibble(Classification = c(EMA_5.5_Days$PRE_Mean_klass, EMA_5.5_Days$POST_Mean_klass),
              Assessment = rep(as_factor(c("PRE Interval Mean", "POST Interval Mean")), each = length(EMA_5.5_Days$PRE_Mean_klass)))#<<

temp %>%
  ggplot(aes(x = Classification, fill = Assessment)) +
    geom_histogram(alpha = 0.2, binwidth = 1, position = "identity") +
    labs(x = "PHQ-9 Classification", y = "")#<<

#ggsave("Plots/k20_EMA_5.5_Days_PHQ-Class_Histogram.jpg", width = 6, height = 4)#<<

1.6 Percentage Change (PC)


\[ PC = \Bigl(1 - \frac{\overline{x_{2}}} {\overline{x_{1}}}\Bigr) \cdot 100 \]

\(\overline{x_{2}}\) = mean of subject´s posttest scores, \(\overline{x_{1}}\) = mean of subject´s pretest scores

Interpretation des Percentage Change:

PC_Int = tibble(PC = c("PC <= -50","-50 < PC <= -25","-25 < PC < 25","25 <= PC < 50","PC >= 50"),
                Klassifikation = c(-2,-1,0,1,2),
                Interpretation = c("starke Verschlechterung","Verschlechterung","keine Veränderung",
                                   "Verbesserung","starke Verbesserung"))

1.6.1 EMA_30.30

EMA_30.30$Mean_PC = (1-(EMA_30.30$POST_Mean / EMA_30.30$PRE_Mean)) * 100

# Sollen Mean_PC %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#EMA_30.30 = EMA_30.30 %>% 
#  within(., {Mean_PC[Mean_PC %in% c(-Inf,Inf)] = NA})

EMA_30.30 = EMA_30.30 %>% 
  mutate(Mean_PC_klass = case_when(
    Mean_PC <= -50 ~ -2,
    Mean_PC > -50 & Mean_PC <= -25 ~ -1,
    Mean_PC > -25 & Mean_PC < 25 ~ 0,
    Mean_PC >= 25 & Mean_PC < 50 ~ 1,
    Mean_PC >= 50 ~ 2,
    TRUE ~ Mean_PC
  )
)


temp = EMA_30.30 %>% 
  dplyr::count(Mean_PC_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

PC_Int %>%
  dplyr::rename(Mean_PC_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
PC Mean_PC_klass Interpretation n Percentage
PC <= -50 -2 starke Verschlechterung 73 0.91
-50 < PC <= -25 -1 Verschlechterung 240 2.99
-25 < PC < 25 0 keine Veränderung 2919 36.31
25 <= PC < 50 1 Verbesserung 2909 36.18
PC >= 50 2 starke Verbesserung 1899 23.62
scatter.hist(EMA_30.30$PRE_Mean, EMA_30.30$Mean_PC, xlab = "EMA_30.30$PRE_Mean", ylab = "EMA_30.30$Mean_PC", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))

Korrelation Mean Percentage Change (je 30 MZP) mit PHQ-Baseline (Pre-Intervall-Mean) = 0.468.


1.6.2 EMA_5.5_Window

EMA_5.5_Window$Mean_PC = (1-(EMA_5.5_Window$POST_Mean / EMA_5.5_Window$PRE_Mean)) * 100

# Sollen Mean_PC %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#EMA_5.5_Window = EMA_5.5_Window %>% 
#  within(., {Mean_PC[Mean_PC %in% c(-Inf,Inf)] = NA})

EMA_5.5_Window = EMA_5.5_Window %>% 
  mutate(Mean_PC_klass = case_when(
    Mean_PC <= -50 ~ -2,
    Mean_PC > -50 & Mean_PC <= -25 ~ -1,
    Mean_PC > -25 & Mean_PC < 25 ~ 0,
    Mean_PC >= 25 & Mean_PC < 50 ~ 1,
    Mean_PC >= 50 ~ 2,
    TRUE ~ Mean_PC
  )
)


temp = EMA_5.5_Window %>% 
  dplyr::count(Mean_PC_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

PC_Int %>%
  dplyr::rename(Mean_PC_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
PC Mean_PC_klass Interpretation n Percentage
PC <= -50 -2 starke Verschlechterung 123 1.53
-50 < PC <= -25 -1 Verschlechterung 313 3.89
-25 < PC < 25 0 keine Veränderung 2791 34.71
25 <= PC < 50 1 Verbesserung 2754 34.25
PC >= 50 2 starke Verbesserung 2059 25.61
scatter.hist(EMA_5.5_Window$PRE_Mean, EMA_5.5_Window$Mean_PC, xlab = "EMA_5.5_Window$PRE_Mean", ylab = "EMA_5.5_Window$Mean_PC", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))

Korrelation Mean Percentage Change (je 5 MZP) mit PHQ-Baseline (Pre-Intervall-Mean) = 0.474.


1.6.3 EMA_5.5_Days

EMA_5.5_Days$Mean_PC = (1-(EMA_5.5_Days$POST_Mean / EMA_5.5_Days$PRE_Mean)) * 100

# Sollen Mean_PC %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#EMA_5.5_Days = EMA_5.5_Days %>% 
#  within(., {Mean_PC[Mean_PC %in% c(-Inf,Inf)] = NA})

EMA_5.5_Days = EMA_5.5_Days %>% 
  mutate(Mean_PC_klass = case_when(
    Mean_PC <= -50 ~ -2,
    Mean_PC > -50 & Mean_PC <= -25 ~ -1,
    Mean_PC > -25 & Mean_PC < 25 ~ 0,
    Mean_PC >= 25 & Mean_PC < 50 ~ 1,
    Mean_PC >= 50 ~ 2,
    TRUE ~ Mean_PC
  )
)


temp = EMA_5.5_Days %>% 
  dplyr::count(Mean_PC_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

PC_Int %>%
  dplyr::rename(Mean_PC_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
PC Mean_PC_klass Interpretation n Percentage
PC <= -50 -2 starke Verschlechterung 225 2.80
-50 < PC <= -25 -1 Verschlechterung 374 4.65
-25 < PC < 25 0 keine Veränderung 2635 32.77
25 <= PC < 50 1 Verbesserung 2550 31.72
PC >= 50 2 starke Verbesserung 2256 28.06
scatter.hist(EMA_5.5_Days$PRE_Mean, EMA_5.5_Days$Mean_PC, xlab = "EMA_5.5_Days$PRE_Mean", ylab = "EMA_5.5_Days$Mean_PC", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))

Korrelation Mean Percentage Change (je 5 MZP) mit PHQ-Baseline (Pre-Intervall-Mean) = 0.494.


1.6.4 Zusammenhang im Scatter-Histogramm

scatter.hist(EMA_30.30$Mean_PC, EMA_5.5_Window$Mean_PC, xlab = "EMA_30.30$Mean_PC", ylab = "EMA_5.5_Window$Mean_PC", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))

scatter.hist(EMA_30.30$Mean_PC, EMA_5.5_Days$Mean_PC, xlab = "EMA_30.30$Mean_PC", ylab = "EMA_5.5_Days$Mean_PC", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))

scatter.hist(EMA_5.5_Window$Mean_PC, EMA_5.5_Days$Mean_PC, xlab = "EMA_5.5_Window$Mean_PC", ylab = "EMA_5.5_Days$Mean_PC", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))


1.7 Individual Reliable Change Index (ind)

1.7.1 RCI(ind) nur mit SD aus dem individuellen Pre-Intervall


\[ RCI_{ind,preSD} = \frac{\overline{x_{2}} - \overline{x_{1}}} {SE_{D,pre}} \]

\[ SE_{D,pre} = \sqrt{2 \cdot (s_{x} \cdot (1 - r_{xy})^2)} \]

\[ \text{significance cutoff} = 1.96 \cdot SE_{D,pre} = 1.96 \cdot \sqrt{2 \cdot (s_{x} \cdot (1 - r_{xy})^2)} \]

\(\overline{x_{2}}\) = mean of subject´s posttest scores, \(\overline{x_{1}}\) = mean of subject´s pretest scores, \(SE_{D,pre}\) = standard error of difference between the test scores in the individual´s pre interval \(s_{x}\) = individual standard deviation of pretest time points, \(r_{xy}\) = reliability (internal consistency Cronbach´s \(\alpha\)) of the measure, \(\text{significance cutoff}\) = (absolute) cutoff score for reliable change (95%-criterion)

EMA_30.30

EMA_30.30$SEd_pre = sqrt(2 * (EMA_30.30$ind.pretestSD * sqrt(1 - EMA_5.5_Alpha)) ^ 2)
EMA_30.30$RCI_ind_preSD = (EMA_30.30$POST_Mean - EMA_30.30$PRE_Mean) / EMA_30.30$SEd_pre
EMA_30.30$RCI_ind_preSD_Cutoff =  1.96 * EMA_30.30$SEd_pre

# Sollen SEd_pre, RCI_ind_preSD und RCI_ind_preSD_Cutoff %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#EMA_30.30 = EMA_30.30 %>% 
#  within(., {SEd_pre[SEd_pre %in% c(-Inf,Inf)] = NA
#               RCI_ind_preSD[RCI_ind_preSD %in% c(-Inf,Inf)] = NA
#               RCI_ind_preSD_Cutoff[RCI_ind_preSD_Cutoff %in% c(-Inf,Inf)] = NA})

scatter.hist(EMA_30.30$PRE_Mean, EMA_30.30$RCI_ind_preSD, xlab = "EMA_30.30$PRE_Mean", ylab = "EMA_30.30$RCI_ind_preSD", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))

Durchschnittlicher RCI(ind)-Cutoff für reliable Veränderung in EMA_30.30 = 4.87.
Korrelation RCI(ind) nur mit Pre-SD (je 30 MZP) mit PHQ-Baseline (Pre-Intervall-Mean) = -0.514.

EMA_5.5_Window

EMA_5.5_Window$SEd_pre = sqrt(2 * (EMA_5.5_Window$ind.pretestSD * sqrt(1 - EMA_5.5_Alpha)) ^ 2)
EMA_5.5_Window$RCI_ind_preSD = (EMA_5.5_Window$POST_Mean - EMA_5.5_Window$PRE_Mean) / EMA_5.5_Window$SEd_pre
EMA_5.5_Window$RCI_ind_preSD_Cutoff =  1.96 * EMA_5.5_Window$SEd_pre

# Sollen SEd_pre, RCI_ind_preSD und RCI_ind_preSD_Cutoff %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#EMA_5.5_Window = EMA_5.5_Window %>% 
#  within(., {SEd_pre[SEd_pre %in% c(-Inf,Inf)] = NA
#               RCI_ind_preSD[RCI_ind_preSD %in% c(-Inf,Inf)] = NA
#               RCI_ind_preSD_Cutoff[RCI_ind_preSD_Cutoff %in% c(-Inf,Inf)] = NA})

scatter.hist(EMA_5.5_Window$PRE_Mean, EMA_5.5_Window$RCI_ind_preSD, xlab = "EMA_5.5_Window$PRE_Mean", ylab = "EMA_5.5_Window$RCI_ind_preSD", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))

Durchschnittlicher RCI(ind)-Cutoff für reliable Veränderung in EMA_5.5_Window = 5.009.
Korrelation RCI(ind) nur mit Pre-SD (je 5 MZP) mit PHQ-Baseline (Pre-Intervall-Mean) = -0.488.

EMA_5.5_Days

EMA_5.5_Days$SEd_pre = sqrt(2 * (EMA_5.5_Days$ind.pretestSD * sqrt(1 - EMA_5.5_Alpha)) ^ 2)
EMA_5.5_Days$RCI_ind_preSD = (EMA_5.5_Days$POST_Mean - EMA_5.5_Days$PRE_Mean) / EMA_5.5_Days$SEd_pre
EMA_5.5_Days$RCI_ind_preSD_Cutoff =  1.96 * EMA_5.5_Days$SEd_pre

# Sollen SEd_pre, RCI_ind_preSD und RCI_ind_preSD_Cutoff %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#EMA_5.5_Days = EMA_5.5_Days %>% 
#  within(., {SEd_pre[SEd_pre %in% c(-Inf,Inf)] = NA
#               RCI_ind_preSD[RCI_ind_preSD %in% c(-Inf,Inf)] = NA
#               RCI_ind_preSD_Cutoff[RCI_ind_preSD_Cutoff %in% c(-Inf,Inf)] = NA})

scatter.hist(EMA_5.5_Days$PRE_Mean, EMA_5.5_Days$RCI_ind_preSD, xlab = "EMA_5.5_Days$PRE_Mean", ylab = "EMA_5.5_Days$RCI_ind_preSD", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))

Durchschnittlicher RCI(ind)-Cutoff für reliable Veränderung in EMA_5.5_Days = 4.694.
Korrelation RCI(ind) nur mit Pre-SD (je 5 MZP) mit PHQ-Baseline (Pre-Intervall-Mean) = -0.487.


1.7.2 RCI(ind) mit pooled SD aus beiden individuellen Intervallen


\[ RCI_{ind} = \frac{\overline{x_{2}} - \overline{x_{1}}} {SE_{D}} \]

\[ SE_{D} = \sqrt{(s_{x}^2 + s_{y}^2) \cdot (1 - r_{xy})} \]

\[ \text{significance cutoff} = 1.96 \cdot SE_{D} = 1.96 \cdot \sqrt{(s_{x}^2 + s_{y}^2) \cdot (1 - r_{xy})} \]

\(\overline{x_{2}}\) = mean of subject´s posttest scores, \(\overline{x_{1}}\) = mean of subject´s pretest scores, \(SE_{D}\) = pooled standard error of difference between the test scores \(s_{x}\) = individual standard deviation of pretest time points, \(s_{y}\) = individual standard deviation of pretest time points, \(r_{xy}\) = reliability (internal consistency Cronbach´s \(\alpha\)) of the measure, \(\text{significance cutoff}\) = (absolute) cutoff score for reliable change (95%-criterion)

EMA_30.30

EMA_30.30$SEd_pooled = sqrt((EMA_30.30$ind.pretestSD ^ 2 + EMA_30.30$ind.posttestSD ^ 2) * (1 - EMA_5.5_Alpha))
EMA_30.30$RCI_ind_pooledSD = (EMA_30.30$POST_Mean - EMA_30.30$PRE_Mean) / EMA_30.30$SEd_pooled
EMA_30.30$RCI_ind_pooledSD_Cutoff =  1.96 * EMA_30.30$SEd_pooled

# Sollen SEd_pooled, RCI_ind_pooledSD und RCI_ind_pooledSD_Cutoff %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#EMA_30.30 = EMA_30.30 %>% 
#  within(., {SEd_pooled[SEd_pooled %in% c(-Inf,Inf)] = NA
#               RCI_ind_pooledSD[RCI_ind_pooledSD %in% c(-Inf,Inf)] = NA
#               RCI_ind_pooledSD_Cutoff[RCI_ind_pooledSD_Cutoff %in% c(-Inf,Inf)] = NA})

scatter.hist(EMA_30.30$PRE_Mean, EMA_30.30$RCI_ind_pooledSD, xlab = "EMA_30.30$PRE_Mean", ylab = "EMA_30.30$RCI_ind_pooledSD", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))

Durchschnittlicher RCI(ind)-Cutoff für reliable Veränderung in EMA_30.30 = 5.681.
Korrelation RCI(ind) mit pooled SDs (je 30 MZP) mit PHQ-Baseline (Pre-Intervall-Mean) = -0.481.

EMA_5.5_Window

EMA_5.5_Window$SEd_pooled = sqrt((EMA_5.5_Window$ind.pretestSD ^ 2 + EMA_5.5_Window$ind.posttestSD ^ 2) * (1 - EMA_5.5_Alpha))
EMA_5.5_Window$RCI_ind_pooledSD = (EMA_5.5_Window$POST_Mean - EMA_5.5_Window$PRE_Mean) / EMA_5.5_Window$SEd_pooled
EMA_5.5_Window$RCI_ind_pooledSD_Cutoff =  1.96 * EMA_5.5_Window$SEd_pooled

# Sollen SEd_pooled, RCI_ind_pooledSD und RCI_ind_pooledSD_Cutoff %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#EMA_5.5_Window = EMA_5.5_Window %>% 
#  within(., {SEd_pooled[SEd_pooled %in% c(-Inf,Inf)] = NA
#               RCI_ind_pooledSD[RCI_ind_pooledSD %in% c(-Inf,Inf)] = NA
#               RCI_ind_pooledSD_Cutoff[RCI_ind_pooledSD_Cutoff %in% c(-Inf,Inf)] = NA})

scatter.hist(EMA_5.5_Window$PRE_Mean, EMA_5.5_Window$RCI_ind_pooledSD, xlab = "EMA_5.5_Window$PRE_Mean", ylab = "EMA_5.5_Window$RCI_ind_pooledSD", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))

Durchschnittlicher RCI(ind)-Cutoff für reliable Veränderung in EMA_5.5_Window = 5.866.
Korrelation RCI(ind) mit pooled SDs (je 5 MZP) mit PHQ-Baseline (Pre-Intervall-Mean) = -0.469.

EMA_5.5_Days

EMA_5.5_Days$SEd_pooled = sqrt((EMA_5.5_Days$ind.pretestSD ^ 2 + EMA_5.5_Days$ind.posttestSD ^ 2) * (1 - EMA_5.5_Alpha))
EMA_5.5_Days$RCI_ind_pooledSD = (EMA_5.5_Days$POST_Mean - EMA_5.5_Days$PRE_Mean) / EMA_5.5_Days$SEd_pooled
EMA_5.5_Days$RCI_ind_pooledSD_Cutoff =  1.96 * EMA_5.5_Days$SEd_pooled

# Sollen SEd_pooled, RCI_ind_pooledSD und RCI_ind_pooledSD_Cutoff %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#EMA_5.5_Days = EMA_5.5_Days %>% 
#  within(., {SEd_pooled[SEd_pooled %in% c(-Inf,Inf)] = NA
#               RCI_ind_pooledSD[RCI_ind_pooledSD %in% c(-Inf,Inf)] = NA
#               RCI_ind_pooledSD_Cutoff[RCI_ind_pooledSD_Cutoff %in% c(-Inf,Inf)] = NA})

scatter.hist(EMA_5.5_Days$PRE_Mean, EMA_5.5_Days$RCI_ind_pooledSD, xlab = "EMA_5.5_Days$PRE_Mean", ylab = "EMA_5.5_Days$RCI_ind_pooledSD", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))

Durchschnittlicher RCI(ind)-Cutoff für reliable Veränderung in EMA_5.5_Days = 5.544.
Korrelation RCI(ind) mit pooled SDs (je 5 MZP) mit PHQ-Baseline (Pre-Intervall-Mean) = -0.476.


1.8 Vergleich RCI(ind) (nur Pre-SD) - RCI(ind) (pooled SDs)

scatter.hist(EMA_30.30$RCI_ind_preSD, EMA_30.30$RCI_ind_pooledSD, xlab = "EMA_30.30$RCI_ind_preSD", ylab =
               "EMA_30.30$RCI_ind_pooledSD", ellipse = FALSE, grid = TRUE, col = c("dodgerblue",  "darkorange"))

scatter.hist(EMA_5.5_Window$RCI_ind_preSD, EMA_5.5_Window$RCI_ind_pooledSD, xlab = "EMA_5.5_Window$RCI_ind_preSD", ylab =
               "EMA_5.5_Window$RCI_ind_pooledSD", ellipse = FALSE, grid = TRUE, col = c("dodgerblue",  "darkorange"))

scatter.hist(EMA_5.5_Days$RCI_ind_preSD, EMA_5.5_Days$RCI_ind_pooledSD, xlab = "EMA_5.5_Days$RCI_ind_preSD", ylab =
               "EMA_5.5_Days$RCI_ind_pooledSD", ellipse = FALSE, grid = TRUE, col = c("dodgerblue",  "darkorange"))


1.9 RCI-Klassifikationen (= RCI + Cutoff-Krit. nach JT)

Clinically Significant Change im Sinne von Jacobson & Truax, also definiert durch einen RCI > |1.96| und die Überschreitung eines empirisch ermittelten Cutoff-Wertes, der die klinische von der gesunden Population von Testwerten trennt.

RCI_Int = tibble(RCI = c("Pre-Score >= 10 & Post-Score <= 9 & RCI < -1,96","every other combination",
                         "Pre-Score <= 9 & Post-Score >= 10 & RCI > 1,96"),
                Klassifikation = c(-1,0,1),
                Interpretation = c("reliable Verbesserung","keine reliable Veränderung","reliable Verschlechterung"))

EMA_30.30: RCI(ind) nur mit Pre-SDs

EMA_30.30 = EMA_30.30 %>% 
  mutate(RCI_ind_preSD_klass = case_when(
    #RCI_ind_preSD < -1.96 ~ -1,
    #RCI_ind_preSD >= -1.96 & RCI_ind_preSD < 1.96 ~ 0,
    #RCI_ind_preSD > 1.96 ~ 1,
    #TRUE ~ RCI_ind_preSD
    PRE_Mean >= 10 & POST_Mean <= 9 & RCI_ind_preSD < -1.96 ~ -1, #<------------- Cutoff-Kriterium hinzugefügt#
    PRE_Mean <= 9 & POST_Mean >= 10 & RCI_ind_preSD > 1.96 ~ 1,
    TRUE ~ 0
  )
)

temp = EMA_30.30 %>% 
  count(RCI_ind_preSD_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

RCI_Int %>%
  dplyr::rename(RCI_ind_preSD_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
RCI RCI_ind_preSD_klass Interpretation n Percentage
Pre-Score >= 10 & Post-Score <= 9 & RCI < -1,96 -1 reliable Verbesserung 2041 25.39
every other combination 0 keine reliable Veränderung 5945 73.94
Pre-Score <= 9 & Post-Score >= 10 & RCI > 1,96 1 reliable Verschlechterung 54 0.67

EMA_30.30: RCI(ind) mit pooled SDs

EMA_30.30 = EMA_30.30 %>% 
  mutate(RCI_ind_pooledSD_klass = case_when(
    #RCI_ind_pooledSD < -1.96 ~ -1,
    #RCI_ind_pooledSD >= -1.96 & RCI_ind_pooledSD < 1.96 ~ 0,
    #RCI_ind_pooledSD > 1.96 ~ 1,
    #TRUE ~ RCI_ind_pooledSD
    PRE_Mean >= 10 & POST_Mean <= 9 & RCI_ind_pooledSD < -1.96 ~ -1, #<------------- Cutoff-Kriterium hinzugefügt#
    PRE_Mean <= 9 & POST_Mean >= 10 & RCI_ind_pooledSD > 1.96 ~ 1,
    TRUE ~ 0
  )
)

temp = EMA_30.30 %>% 
  count(RCI_ind_pooledSD_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

RCI_Int %>%
  dplyr::rename(RCI_ind_pooledSD_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
RCI RCI_ind_pooledSD_klass Interpretation n Percentage
Pre-Score >= 10 & Post-Score <= 9 & RCI < -1,96 -1 reliable Verbesserung 1687 20.98
every other combination 0 keine reliable Veränderung 6340 78.86
Pre-Score <= 9 & Post-Score >= 10 & RCI > 1,96 1 reliable Verschlechterung 13 0.16

EMA_5.5_Window: RCI(ind) nur mit Pre-SDs

EMA_5.5_Window = EMA_5.5_Window %>% 
  mutate(RCI_ind_preSD_klass = case_when(
    #RCI_ind_preSD < -1.96 ~ -1,
    #RCI_ind_preSD >= -1.96 & RCI_ind_preSD < 1.96 ~ 0,
    #RCI_ind_preSD > 1.96 ~ 1,
    #TRUE ~ RCI_ind_preSD
    PRE_Mean >= 10 & POST_Mean <= 9 & RCI_ind_preSD < -1.96 ~ -1, #<------------- Cutoff-Kriterium hinzugefügt#
    PRE_Mean <= 9 & POST_Mean >= 10 & RCI_ind_preSD > 1.96 ~ 1,
    TRUE ~ 0
  )
)

temp = EMA_5.5_Window %>% 
  count(RCI_ind_preSD_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

RCI_Int %>%
  dplyr::rename(RCI_ind_preSD_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
RCI RCI_ind_preSD_klass Interpretation n Percentage
Pre-Score >= 10 & Post-Score <= 9 & RCI < -1,96 -1 reliable Verbesserung 2054 25.55
every other combination 0 keine reliable Veränderung 5899 73.37
Pre-Score <= 9 & Post-Score >= 10 & RCI > 1,96 1 reliable Verschlechterung 87 1.08

EMA_5.5_Window: RCI(ind) mit pooled SDs

EMA_5.5_Window = EMA_5.5_Window %>% 
  mutate(RCI_ind_pooledSD_klass = case_when(
    #RCI_ind_pooledSD < -1.96 ~ -1,
    #RCI_ind_pooledSD >= -1.96 & RCI_ind_pooledSD < 1.96 ~ 0,
    #RCI_ind_pooledSD > 1.96 ~ 1,
    #TRUE ~ RCI_ind_pooledSD
    PRE_Mean >= 10 & POST_Mean <= 9 & RCI_ind_pooledSD < -1.96 ~ -1, #<------------- Cutoff-Kriterium hinzugefügt#
    PRE_Mean <= 9 & POST_Mean >= 10 & RCI_ind_pooledSD > 1.96 ~ 1,
    TRUE ~ 0
  )
)

temp = EMA_5.5_Window %>% 
  count(RCI_ind_pooledSD_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

RCI_Int %>%
  dplyr::rename(RCI_ind_pooledSD_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
RCI RCI_ind_pooledSD_klass Interpretation n Percentage
Pre-Score >= 10 & Post-Score <= 9 & RCI < -1,96 -1 reliable Verbesserung 1750 21.77
every other combination 0 keine reliable Veränderung 6260 77.86
Pre-Score <= 9 & Post-Score >= 10 & RCI > 1,96 1 reliable Verschlechterung 30 0.37

EMA_5.5_Days: RCI(ind) nur mit Pre-SDs

EMA_5.5_Days = EMA_5.5_Days %>% 
  mutate(RCI_ind_preSD_klass = case_when(
    #RCI_ind_preSD < -1.96 ~ -1,
    #RCI_ind_preSD >= -1.96 & RCI_ind_preSD < 1.96 ~ 0,
    #RCI_ind_preSD > 1.96 ~ 1,
    #TRUE ~ RCI_ind_preSD
    PRE_Mean >= 10 & POST_Mean <= 9 & RCI_ind_preSD < -1.96 ~ -1, #<------------- Cutoff-Kriterium hinzugefügt#
    PRE_Mean <= 9 & POST_Mean >= 10 & RCI_ind_preSD > 1.96 ~ 1,
    TRUE ~ 0
  )
)

temp = EMA_5.5_Days %>% 
  count(RCI_ind_preSD_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

RCI_Int %>%
  dplyr::rename(RCI_ind_preSD_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
RCI RCI_ind_preSD_klass Interpretation n Percentage
Pre-Score >= 10 & Post-Score <= 9 & RCI < -1,96 -1 reliable Verbesserung 2338 29.08
every other combination 0 keine reliable Veränderung 5550 69.03
Pre-Score <= 9 & Post-Score >= 10 & RCI > 1,96 1 reliable Verschlechterung 152 1.89

EMA_5.5_Days: RCI(ind) mit pooled SDs

EMA_5.5_Days = EMA_5.5_Days %>% 
  mutate(RCI_ind_pooledSD_klass = case_when(
    #RCI_ind_pooledSD < -1.96 ~ -1,
    #RCI_ind_pooledSD >= -1.96 & RCI_ind_pooledSD < 1.96 ~ 0,
    #RCI_ind_pooledSD > 1.96 ~ 1,
    #TRUE ~ RCI_ind_pooledSD
    PRE_Mean >= 10 & POST_Mean <= 9 & RCI_ind_pooledSD < -1.96 ~ -1, #<------------- Cutoff-Kriterium hinzugefügt#
    PRE_Mean <= 9 & POST_Mean >= 10 & RCI_ind_pooledSD > 1.96 ~ 1,
    TRUE ~ 0
  )
)

temp = EMA_5.5_Days %>% 
  count(RCI_ind_pooledSD_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

RCI_Int %>%
  dplyr::rename(RCI_ind_pooledSD_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
RCI RCI_ind_pooledSD_klass Interpretation n Percentage
Pre-Score >= 10 & Post-Score <= 9 & RCI < -1,96 -1 reliable Verbesserung 2001 24.89
every other combination 0 keine reliable Veränderung 5965 74.19
Pre-Score <= 9 & Post-Score >= 10 & RCI > 1,96 1 reliable Verschlechterung 74 0.92

1.10 Edwards-Nunnally-Methode (EN) nach Speer (1992)


\[ \bigl[ r_{xx} (X_{pre} - M_{pre}) + M_{pre} \bigr] \pm 2 \cdot S_{pre} \cdot \sqrt{1 - r_{xx}} \]

\(r_{xx}\) = reliability of the measure, \(X_{pre}\) = individual´s raw score at pre-treatment, \(M_{pre}\) = mean of the sample at pre-treatment, \(S_{pre}\) = standard deviation of the sample at pre-treatment

Interpretation der Post-Ausprägung nach EN-Intervall-Methode

EN_Int = tibble(EN = c("PHQ POST < [EN-Intervall]","PHQ POST im [EN-Intervall]","PHQ POST > [EN-Intervall]"),
                Klassifikation = c(-1,0,1), Interpretation = c("signifikante Verbesserung",
                        "keine signifikante Veränderung","signifikante Verschlechterung"))

EN-Intervalle in EMA_30.30

EMA_30.30$EN_min = (EMA_5.5_Alpha * (EMA_30.30$PRE_Mean - mean(EMA_30.30$PRE_Mean)) + mean(EMA_30.30$PRE_Mean)) - 2 * mean(EMA_30.30$ind.pretestSD) * sqrt(1 - EMA_5.5_Alpha)

EMA_30.30$EN_max = (EMA_5.5_Alpha * (EMA_30.30$PRE_Mean - mean(EMA_30.30$PRE_Mean)) + mean(EMA_30.30$PRE_Mean)) + 2 * mean(EMA_30.30$ind.pretestSD) * sqrt(1 - EMA_5.5_Alpha)

EMA_30.30 = EMA_30.30 %>% 
  mutate(EN_klass = case_when(
    POST_Mean > EN_max ~ 1,
    POST_Mean <= EN_max & POST_Mean >= EN_min ~ 0,
    POST_Mean < EN_min ~ -1,
    TRUE ~ POST_Mean
  )
)

temp = EMA_30.30 %>% 
  count(EN_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

EN_Int %>%
  dplyr::rename(EN_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
EN EN_klass Interpretation n Percentage
PHQ POST < [EN-Intervall] -1 signifikante Verbesserung 3730 46.39
PHQ POST im [EN-Intervall] 0 keine signifikante Veränderung 4293 53.40
PHQ POST > [EN-Intervall] 1 signifikante Verschlechterung 17 0.21

EN-Intervalle in EMA_5.5_Window

EMA_5.5_Window$EN_min = (EMA_5.5_Alpha * (EMA_5.5_Window$PRE_Mean - mean(EMA_5.5_Window$PRE_Mean)) + 
                           mean(EMA_5.5_Window$PRE_Mean)) - 2 *  mean(EMA_5.5_Window$ind.pretestSD) * sqrt(1 - EMA_5.5_Alpha)

EMA_5.5_Window$EN_max = (EMA_5.5_Alpha * (EMA_5.5_Window$PRE_Mean - mean(EMA_5.5_Window$PRE_Mean)) + 
                           mean(EMA_5.5_Window$PRE_Mean)) + 2 * mean(EMA_5.5_Window$ind.pretestSD) * sqrt(1 - EMA_5.5_Alpha)

EMA_5.5_Window = EMA_5.5_Window %>% 
  mutate(EN_klass = case_when(
    POST_Mean > EN_max ~ 1,
    POST_Mean <= EN_max & POST_Mean >= EN_min ~ 0,
    POST_Mean < EN_min ~ -1,
    TRUE ~ POST_Mean
  )
)

temp = EMA_5.5_Window %>% 
  count(EN_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

EN_Int %>%
  dplyr::rename(EN_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
EN EN_klass Interpretation n Percentage
PHQ POST < [EN-Intervall] -1 signifikante Verbesserung 3748 46.62
PHQ POST im [EN-Intervall] 0 keine signifikante Veränderung 4249 52.85
PHQ POST > [EN-Intervall] 1 signifikante Verschlechterung 43 0.53

EN-Intervalle in EMA_5.5_Days

EMA_5.5_Days$EN_min = (EMA_5.5_Alpha * (EMA_5.5_Days$PRE_Mean - mean(EMA_5.5_Days$PRE_Mean)) + 
                           mean(EMA_5.5_Days$PRE_Mean)) - 2 *  mean(EMA_5.5_Days$ind.pretestSD) * sqrt(1 - EMA_5.5_Alpha)

EMA_5.5_Days$EN_max = (EMA_5.5_Alpha * (EMA_5.5_Days$PRE_Mean - mean(EMA_5.5_Days$PRE_Mean)) + 
                           mean(EMA_5.5_Days$PRE_Mean)) + 2 * mean(EMA_5.5_Days$ind.pretestSD) * sqrt(1 - EMA_5.5_Alpha)

EMA_5.5_Days = EMA_5.5_Days %>% 
  mutate(EN_klass = case_when(
    POST_Mean > EN_max ~ 1,
    POST_Mean <= EN_max & POST_Mean >= EN_min ~ 0,
    POST_Mean < EN_min ~ -1,
    TRUE ~ POST_Mean
  )
)

temp = EMA_5.5_Days %>% 
  count(EN_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

EN_Int %>%
  dplyr::rename(EN_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
EN EN_klass Interpretation n Percentage
PHQ POST < [EN-Intervall] -1 signifikante Verbesserung 3993 49.66
PHQ POST im [EN-Intervall] 0 keine signifikante Veränderung 3906 48.58
PHQ POST > [EN-Intervall] 1 signifikante Verschlechterung 141 1.75

1.11 Clinically Significant Improvement (CSI)

Clinically Significant Improvement (CSI) vom Pre- zum Post-Intervall

“The original validation study of the PHQ-9 defined clinically significant improvement as [a pre-treatment score >= 10 and] a post-treatment score of <= 9 combined with improvement of 50%.” (McMillan, Gilbody, & Richards, 2010)

CSI_Int = tibble(CSI = c("Pre-Score >= 10 & Post-Score <= 9 & PC >= 50", "every other combination", 
                         "Pre-Score <= 9 & Post-Score >= 10 & PC <= -50"),
                Klassifikation = c(-1,0,1),
                Interpretation = c("klinisch signifikante Verbesserung", "keine klinisch signifikante Veränderung", 
                                   "klinisch signifikante Verschlechterung"))

1.11.1 CSI in EMA_30.30

EMA_30.30 = EMA_30.30 %>% 
   mutate(CSI_klass = case_when(
     PRE_Mean >= 10 & POST_Mean <= 9 & Mean_PC >= 50 ~ -1,
     PRE_Mean <= 9 & POST_Mean >= 10 & Mean_PC <= -50 ~ 1,
     TRUE ~ 0
   )
)

temp = EMA_30.30 %>% 
  count(CSI_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

CSI_Int %>%
  dplyr::rename(CSI_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
CSI CSI_klass Interpretation n Percentage
Pre-Score >= 10 & Post-Score <= 9 & PC >= 50 -1 klinisch signifikante Verbesserung 1458 18.13
every other combination 0 keine klinisch signifikante Veränderung 6523 81.13
Pre-Score <= 9 & Post-Score >= 10 & PC <= -50 1 klinisch signifikante Verschlechterung 59 0.73

1.11.2 CSI in EMA_5.5_Window

EMA_5.5_Window = EMA_5.5_Window %>% 
   mutate(CSI_klass = case_when(
     PRE_Mean >= 10 & POST_Mean <= 9 & Mean_PC >= 50 ~ -1,
     PRE_Mean <= 9 & POST_Mean >= 10 & Mean_PC <= -50 ~ 1,
     TRUE ~ 0
   )
)

temp = EMA_5.5_Window %>% 
  count(CSI_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

CSI_Int %>%
  dplyr::rename(CSI_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
CSI CSI_klass Interpretation n Percentage
Pre-Score >= 10 & Post-Score <= 9 & PC >= 50 -1 klinisch signifikante Verbesserung 1582 19.68
every other combination 0 keine klinisch signifikante Veränderung 6359 79.09
Pre-Score <= 9 & Post-Score >= 10 & PC <= -50 1 klinisch signifikante Verschlechterung 99 1.23

1.11.3 CSI in EMA_5.5_Days

EMA_5.5_Days = EMA_5.5_Days %>% 
   mutate(CSI_klass = case_when(
     PRE_Mean >= 10 & POST_Mean <= 9 & Mean_PC >= 50 ~ -1,
     PRE_Mean <= 9 & POST_Mean >= 10 & Mean_PC <= -50 ~ 1,
     TRUE ~ 0
   )
)

temp = EMA_5.5_Days %>% 
  count(CSI_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

CSI_Int %>%
  dplyr::rename(CSI_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
CSI CSI_klass Interpretation n Percentage
Pre-Score >= 10 & Post-Score <= 9 & PC >= 50 -1 klinisch signifikante Verbesserung 1688 21.00
every other combination 0 keine klinisch signifikante Veränderung 6169 76.73
Pre-Score <= 9 & Post-Score >= 10 & PC <= -50 1 klinisch signifikante Verschlechterung 183 2.28

# Speichern der Datasets inkl. aller Klassifikationsvariablen ----------- nötig?
EMA_30.30_final = EMA_30.30
EMA_5.5_Window_final = EMA_5.5_Window
EMA_5.5_Days_final = EMA_5.5_Days

save(EMA_30.30_final, file = "cor_04_k20/EMA_30.30_final.RData")#<<
save(EMA_5.5_Window_final, file = "cor_04_k20/EMA_5.5_Window_final.RData")#<<
save(EMA_5.5_Days_final, file = "cor_04_k20/EMA_5.5_Days_final.RData")#<<
# Für eine Tabelle der alleinigen Klassifikationen aus allen 3 Datensets im einheitlichen Format (-1,0,1) 
# siehe die Erstellung von EMA_Class.RData unten.

1.12 Individuelle Übereinstimmung der Klassifikationen

Übereinstimmung der Klassifikationen auf individueller Ebene zwischen EMA_30.30, EMA_5.5_Window und EMA_5.5_Days

Interpretation von Cohen´s Kappa:

tibble(Cohen_Kappa = c("k < .20",".21 <= k < .40",".41 <= k < .60",".61 <= k < .80","k > .80"),
       Interpretation = c("poor","fair","moderate","good","very good")) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
Cohen_Kappa Interpretation
k < .20 poor
.21 <= k < .40 fair
.41 <= k < .60 moderate
.61 <= k < .80 good
k > .80 very good

1.12.1 Klinische PHQ-9-Interpretation

Übereinstimmung zwischen den klinischen Interpretationen der PHQ-9-Werte für Pre- und Post-Intervalle (je 30 MZP und je 5 MZP):

# PRE
x = EMA_30.30 %>% 
  select(ID, PRE_Mean_klass) %>% 
  dplyr::rename(PRE_klass_30.30 = PRE_Mean_klass)

y = EMA_5.5_Window %>% 
  select(ID, PRE_Mean_klass) %>% 
  dplyr::rename(PRE_klass_5.5_Window = PRE_Mean_klass)

z = EMA_5.5_Days %>% 
  select(ID, PRE_Mean_klass) %>% 
  dplyr::rename(PRE_klass_5.5_Days = PRE_Mean_klass)

temp = full_join(x, y, by = "ID") %>% 
  full_join(., z, by = "ID") %>% 
  select(-ID) %>% 
  mutate(across(.cols = everything(), as.factor))

### Cohen´s Kappa
rnames = c("PRE_klass_30.30", "PRE_klass_5.5_Window", "PRE_klass_5.5_Days")

Agreement = matrix(ncol = 3, nrow = 3, dimnames = list(rnames, rnames))

for (i in 1:nrow(Agreement)) {
  for (j in 1:ncol(Agreement)) {
    x = eval(parse(text = paste0("temp$", names(temp[,i]))))
    y = eval(parse(text = paste0("temp$", names(temp[,j]))))
    
    Agreement[i,j] = CohenKappa(x = x, y = y)
  }
}

# mit plot.matrix::...
par(mar = c(5.1, 4.1, 4.1, 4.1)) # default c(5.1, 4.1, 4.1, 2.1)
plot(Agreement, col = heat.colors(n=5, rev=TRUE), fmt.cell = "%.2f", cex.axis = 0.7, cex = 0.8, las = 2, 
     key = list(cex.axis=0.7), ann = FALSE, breaks = c(0, 0.21, 0.41, 0.61, 0.81, 1));
  title(main = "Übereinstimmung (Cohen´s Kappa) der PHQ-PRE-Klassifikationen")

# POST
x = EMA_30.30 %>% 
  select(ID, POST_Mean_klass) %>% 
  dplyr::rename(POST_klass_30.30 = POST_Mean_klass)

y = EMA_5.5_Window %>% 
  select(ID, POST_Mean_klass) %>% 
  dplyr::rename(POST_klass_5.5_Window = POST_Mean_klass)

z = EMA_5.5_Days %>% 
  select(ID, POST_Mean_klass) %>% 
  dplyr::rename(POST_klass_5.5_Days = POST_Mean_klass)

temp = full_join(x, y, by = "ID") %>% 
  full_join(., z, by = "ID") %>% 
  select(-ID) %>% 
  mutate(across(.cols = everything(), as.factor))

### Cohen´s Kappa
rnames = c("POST_klass_30.30", "POST_klass_5.5_Window", "POST_klass_5.5_Days")

Agreement = matrix(ncol = 3, nrow = 3, dimnames = list(rnames, rnames))

for (i in 1:nrow(Agreement)) {
  for (j in 1:ncol(Agreement)) {
    x = eval(parse(text = paste0("temp$", names(temp[,i]))))
    y = eval(parse(text = paste0("temp$", names(temp[,j]))))
    
    Agreement[i,j] = CohenKappa(x = x, y = y)
  }
}

# mit plot.matrix::...
par(mar = c(5.1, 4.1, 4.1, 4.1)) # default c(5.1, 4.1, 4.1, 2.1)
plot(Agreement, col = heat.colors(n=5, rev=TRUE), fmt.cell = "%.2f", cex.axis = 0.7, cex = 0.8, las = 2, 
     key = list(cex.axis=0.7), ann = FALSE, breaks = c(0, 0.21, 0.41, 0.61, 0.81, 1));
  title(main = "Übereinstimmung (Cohen´s Kappa) der PHQ-POST-Klassifikationen")


1.12.2 Zusammenfassung der Klassifikations-Häufigkeiten

# einheitliche Kodierung von Verbesserung (-1), keiner Veränderung (0) und Verschlechterung (1):

x = EMA_30.30 %>% 
  select(ID, Mean_PC_klass, RCI_ind_preSD_klass, RCI_ind_pooledSD_klass, EN_klass, CSI_klass) %>% 
  dplyr::rename(Mean_PC_30.30 = Mean_PC_klass, RCI_ind_preSD_30.30 = RCI_ind_preSD_klass, 
         RCI_ind_pooledSD_30.30 = RCI_ind_pooledSD_klass, EN_30.30 = EN_klass, CSI_30.30 = CSI_klass) %>% 
  mutate(Mean_PC_30.30 = recode(Mean_PC_30.30, '-2' = 1L, '-1' = 0L, '0' = 0L, '1' = 0L, '2' = -1L))

y = EMA_5.5_Window %>% 
  select(ID, Mean_PC_klass, RCI_ind_preSD_klass, RCI_ind_pooledSD_klass, EN_klass, CSI_klass) %>% 
  dplyr::rename(Mean_PC_5.5_Window = Mean_PC_klass, RCI_ind_preSD_5.5_Window = RCI_ind_preSD_klass, 
         RCI_ind_pooledSD_5.5_Window = RCI_ind_pooledSD_klass, EN_5.5_Window = EN_klass, CSI_5.5_Window = CSI_klass) %>% 
  mutate(Mean_PC_5.5_Window = recode(Mean_PC_5.5_Window, '-2' = 1L, '-1' = 0L, '0' = 0L, '1' = 0L, '2' = -1L))

z = EMA_5.5_Days %>% 
  select(ID, Mean_PC_klass, RCI_ind_preSD_klass, RCI_ind_pooledSD_klass, EN_klass, CSI_klass) %>% 
  dplyr::rename(Mean_PC_5.5_Days = Mean_PC_klass, RCI_ind_preSD_5.5_Days = RCI_ind_preSD_klass, 
         RCI_ind_pooledSD_5.5_Days = RCI_ind_pooledSD_klass, EN_5.5_Days = EN_klass, CSI_5.5_Days = CSI_klass) %>% 
  mutate(Mean_PC_5.5_Days = recode(Mean_PC_5.5_Days, '-2' = 1L, '-1' = 0L, '0' = 0L, '1' = 0L, '2' = -1L))

EMA_Class = full_join(x, y, by = "ID") %>% 
  full_join(., z, "ID") %>% 
  select(-ID) %>% 
  dplyr::mutate(across(.cols = everything(), as.factor))
#save(EMA_Class, file = "cor_04_k20/EMA_Class.RData")

rnames = names(EMA_Class)

#view(dfSummary(EMA_Class))
#dfSummary(EMA_Class, plain.ascii = FALSE, style = 'grid', graph.magnif = 0.75, valid.col = FALSE, tmp.img.dir = "/tmp")
#dfSummary(EMA_Class)
print(dfSummary(EMA_Class, varnumbers = FALSE, plain.ascii = FALSE, style = 'grid', graph.magnif = 0.75, valid.col = FALSE, na.col = FALSE, display.labels = FALSE, silent = FALSE, headers = FALSE, footnote = NA, tmp.img.dir = "/tmp"), method = 'render')

Data Frame Summary

EMA_Class

Dimensions: 8040 x 15
Duplicates: 7370
Variable Stats / Values Freqs (% of Valid) Graph
Mean_PC_30.30 [factor] 1. -1 2. 0 3. 1
1899(23.6%)
6068(75.5%)
73(0.9%)
RCI_ind_preSD_30.30 [factor] 1. -1 2. 0 3. 1
2041(25.4%)
5945(73.9%)
54(0.7%)
RCI_ind_pooledSD_30.30 [factor] 1. -1 2. 0 3. 1
1687(21.0%)
6340(78.9%)
13(0.2%)
EN_30.30 [factor] 1. -1 2. 0 3. 1
3730(46.4%)
4293(53.4%)
17(0.2%)
CSI_30.30 [factor] 1. -1 2. 0 3. 1
1458(18.1%)
6523(81.1%)
59(0.7%)
Mean_PC_5.5_Window [factor] 1. -1 2. 0 3. 1
2059(25.6%)
5858(72.9%)
123(1.5%)
RCI_ind_preSD_5.5_Window [factor] 1. -1 2. 0 3. 1
2054(25.5%)
5899(73.4%)
87(1.1%)
RCI_ind_pooledSD_5.5_Window [factor] 1. -1 2. 0 3. 1
1750(21.8%)
6260(77.9%)
30(0.4%)
EN_5.5_Window [factor] 1. -1 2. 0 3. 1
3748(46.6%)
4249(52.8%)
43(0.5%)
CSI_5.5_Window [factor] 1. -1 2. 0 3. 1
1582(19.7%)
6359(79.1%)
99(1.2%)
Mean_PC_5.5_Days [factor] 1. -1 2. 0 3. 1
2256(28.1%)
5559(69.1%)
225(2.8%)
RCI_ind_preSD_5.5_Days [factor] 1. -1 2. 0 3. 1
2338(29.1%)
5550(69.0%)
152(1.9%)
RCI_ind_pooledSD_5.5_Days [factor] 1. -1 2. 0 3. 1
2001(24.9%)
5965(74.2%)
74(0.9%)
EN_5.5_Days [factor] 1. -1 2. 0 3. 1
3993(49.7%)
3906(48.6%)
141(1.8%)
CSI_5.5_Days [factor] 1. -1 2. 0 3. 1
1688(21.0%)
6169(76.7%)
183(2.3%)

Generated by summarytools 0.9.8 (R version 4.0.2)
2021-08-20


1.12.3 Übereinstimmung der Klassifikations-Häufigkeiten

Gesamt-Übereinstimmung

### Cohen´s Kappa
Agreement = matrix(ncol = 15, nrow = 15, dimnames = list(rnames, rnames))

for (i in 1:nrow(Agreement)) {
  for (j in 1:ncol(Agreement)) {
    x = eval(parse(text = paste0("EMA_Class$", names(EMA_Class[,i]))))
    y = eval(parse(text = paste0("EMA_Class$", names(EMA_Class[,j]))))
    
    Agreement[i,j] = CohenKappa(x = x, y = y)
  }
}

# mit plot.matrix::...
par(mar = c(5.1, 4.1, 4.1, 4.1)) # default c(5.1, 4.1, 4.1, 2.1)
plot(Agreement, col = heat.colors(n=5, rev=TRUE), fmt.cell = "%.2f", cex.axis = 0.5, cex = 0.7, las = 2, 
     key = list(cex.axis=0.6), ann = FALSE, breaks = c(0, 0.21, 0.41, 0.61, 0.81, 1));
  title(main = "Übereinstimmung (Cohen´s Kappa) der Klassifikationen")

### Prozentuale Übereinstimmung
Percentage_Agreement = matrix(ncol = 15, nrow = 15, dimnames = list(rnames, rnames))

for (i in 1:nrow(Percentage_Agreement)) {
  for (j in 1:ncol(Percentage_Agreement)) {
    x = eval(parse(text = paste0("EMA_Class$", names(EMA_Class[,i]))))
    y = eval(parse(text = paste0("EMA_Class$", names(EMA_Class[,j]))))
    
    Percentage_Agreement[i,j] = Agree(cbind(x, y))[1]
  }
}

# mit plot.matrix::...
par(mar = c(5.1, 4.1, 4.1, 4.1)) # default c(5.1, 4.1, 4.1, 2.1)
plot(Percentage_Agreement, col = heat.colors(n=4, rev=TRUE), fmt.cell = "%.2f", cex.axis = 0.5, cex = 0.7, las = 2, 
     key = list(cex.axis=0.6), ann = FALSE, breaks = c(0, 0.26, 0.51, 0.76, 1));
  title(main = "Prozentuale Übereinstimmung der Klassifikationen")

Übereinstimmung nur für Verbesserung (-1)

### Cohen´s Kappa
Agreement = matrix(ncol = 15, nrow = 15, dimnames = list(rnames, rnames))

for (i in 1:nrow(Agreement)) {
  for (j in 1:ncol(Agreement)) {
    x = eval(parse(text = paste0("EMA_Class$", names(EMA_Class[,i])))) %>% 
      dplyr::recode_factor(., '-1' = -1L)
    y = eval(parse(text = paste0("EMA_Class$", names(EMA_Class[,j])))) %>% 
      dplyr::recode_factor(., '-1' = -1L)
    
    Agreement[i,j] = CohenKappa(x = x, y = y, useNA = "ifany")
  }
}

# mit plot.matrix::...
par(mar = c(5.1, 4.1, 4.1, 4.1)) # default c(5.1, 4.1, 4.1, 2.1)
plot(Agreement, col = heat.colors(n=5, rev=TRUE), fmt.cell = "%.2f", cex.axis = 0.5, cex = 0.7, las = 2, 
     key = list(cex.axis=0.6), ann = FALSE, breaks = c(0, 0.21, 0.41, 0.61, 0.81, 1));
  title(main = "Übereinstimmung (Cohen´s Kappa): Verbesserung (-1)")

### Prozentuale Übereinstimmung
Percentage_Agreement = matrix(ncol = 15, nrow = 15, dimnames = list(rnames, rnames))

for (i in 1:nrow(Percentage_Agreement)) {
  for (j in 1:ncol(Percentage_Agreement)) {
    x = eval(parse(text = paste0("EMA_Class$", names(EMA_Class[,i]))))
    y = eval(parse(text = paste0("EMA_Class$", names(EMA_Class[,j]))))
    
    Percentage_Agreement[i,j] = length(which(x == -1L & y == -1L)) / 
      length(which(x == -1L | y == -1L))
  }
}

# mit plot.matrix::...
par(mar = c(5.1, 4.1, 4.1, 4.1)) # default c(5.1, 4.1, 4.1, 2.1)
plot(Percentage_Agreement, col = heat.colors(n=4, rev=TRUE), fmt.cell = "%.2f", cex.axis = 0.5, cex = 0.7, las = 2, 
     key = list(cex.axis=0.6), ann = FALSE, breaks = c(0, 0.26, 0.51, 0.76, 1));
  title(main = "Prozentuale Übereinstimmung: Verbesserung (-1)")

Übereinstimmung nur für Verschlechterung (1)

### Cohen´s Kappa
Agreement = matrix(ncol = 15, nrow = 15, dimnames = list(rnames, rnames))

for (i in 1:nrow(Agreement)) {
  for (j in 1:ncol(Agreement)) {
    x = eval(parse(text = paste0("EMA_Class$", names(EMA_Class[,i])))) %>% 
      recode_factor(., '1' = 1L)
    y = eval(parse(text = paste0("EMA_Class$", names(EMA_Class[,j])))) %>% 
      recode_factor(., '1' = 1L)
    
    Agreement[i,j] = CohenKappa(x = x, y = y, useNA = "ifany")
  }
}

# mit plot.matrix::...
par(mar = c(5.1, 4.1, 4.1, 4.1)) # default c(5.1, 4.1, 4.1, 2.1)
plot(Agreement, col = heat.colors(n=5, rev=TRUE), fmt.cell = "%.2f", cex.axis = 0.5, cex = 0.7, las = 2, 
     key = list(cex.axis=0.6), ann = FALSE, breaks = c(0, 0.21, 0.41, 0.61, 0.81, 1));
  title(main = "Übereinstimmung (Cohen´s Kappa): Verschlechterung (1)")

### Prozentuale Übereinstimmung
Percentage_Agreement = matrix(ncol = 15, nrow = 15, dimnames = list(rnames, rnames))

for (i in 1:nrow(Percentage_Agreement)) {
  for (j in 1:ncol(Percentage_Agreement)) {
    x = eval(parse(text = paste0("EMA_Class$", names(EMA_Class[,i]))))
    y = eval(parse(text = paste0("EMA_Class$", names(EMA_Class[,j]))))
    
    Percentage_Agreement[i,j] = length(which(x == 1L & y == 1L)) / 
      length(which(x == 1L | y == 1L))
  }
}

# mit plot.matrix::...
par(mar = c(5.1, 4.1, 4.1, 4.1)) # default c(5.1, 4.1, 4.1, 2.1)
plot(Percentage_Agreement, col = heat.colors(n=4, rev=TRUE), fmt.cell = "%.2f", cex.axis = 0.5, cex = 0.7, las = 2, 
     key = list(cex.axis=0.6), ann = FALSE, breaks = c(0, 0.26, 0.51, 0.76, 1));
  title(main = "Prozentuale Übereinstimmung: Verschlechterung (1)")


1.13 Sensitivität und Spezifität der Klassifikationsmethoden

Diagnostische Sensitivität und Spezifität einer “neuen” Testmethode im Vergleich zu einer “Goldstandard”-Testmethode:
Sensitivität = Wahrscheinlichkeit für ein richtig-positives Testergebnis
Spezifität = Wahrscheinlichkeit für ein richtig-negatives Testergebnis

\[ Sensitivity = Recall = TPR = \frac{\sum{\text{True Positives}}} {\sum{\text{True Positives}} + \sum{\text{False Negatives}}} = \frac{tp}{tp + fn} \]

\[ Specificity = Selectivity = TNR = \frac{\sum{\text{True Negatives}}} {\sum{\text{True Negatives}} + \sum{\text{False Positives}}} = \frac{tn}{tn + fp} \]

\[ \textit{Geometric Mean of Sensitivity and Specificity} = \sqrt{Sensitivity \cdot Specificity} \]

\[ Sensitivity_{\textit{class-weighted average}} = Recall_{wgt} = \rho_{wgt} = \sum_{k=1}^{c} \frac{n_k}{n} \rho_k = \frac{1}{n} \sum_{k=1}^{c} tp^{(k)} = \frac{tp^{(deteriorated)}} {tp^{(deteriorated)} + fn^{(deteriorated)}} + \frac{tp^{(\textit{not changed})}} {tp^{(\textit{not changed})} + fn^{(\textit{not changed})}} + \frac{tp^{(improved)}} {tp^{(improved)} + fn^{(improved)}} \]

\(c\) = number of classes (i.e. 3: deteriorated; not changed; improved); \(n_k\) = number of cases belonging to class \(k\), with \(k=1,...,c\); \(n\) = total number of cases, with \(n = \sum_{k=1}^{c} n_k\)

Sensitivität & Spezifität gegenüber Veränderung:
Evaluation der Veränderungs-Klassifikationen der Klassifikationsmethoden im Vergleich zur klinischen Signifikanz CSI (je 30 MZP) als “Goldstandard”:

ClassEval = list()
for (i in 1:ncol(EMA_Class)) {
  x = eval(parse(text = paste0("EMA_Class$", colnames(EMA_Class[,i]))))
  cm = confusionMatrix(x, reference = EMA_Class$CSI_30.30, 
                       dnn = c(paste0("EMA_Class$", names(EMA_Class[,i])), "CSI 30.30"), mode = "everything")
  cm$agreement = cm$overall[c("Accuracy","Kappa")]
  cm$senspez = cm$byClass %>% 
    as_tibble() %>% 
    select(Sensitivity, Specificity)
  
  cm$senspez_cwa = cm$senspez %>% 
    summarise(across(.cols = everything(), .fns = geometric.mean, .names = "{.col}_cwa")) %>% 
    mutate(GMean_SenSpez = geometric.mean(c(Sensitivity_cwa, Specificity_cwa)))
  
  ClassEval[[paste0(names(EMA_Class[,i]))]] = cm[c("table","agreement","senspez","senspez_cwa")]
}

#save(ClassEval, file = "cor_04_k20/EMA_ClassEval.RData")
#load("cor_04_k20/EMA_Class.RData")

SenSpezSumm = tibble(Frequency = as.factor(c(rep("30.30", 5), rep("5.5", 10))),
                 Method = colnames(EMA_Class),
                 Sens_imp = as.numeric(NA),
                 Sens_not = as.numeric(NA),
                 Sens_det = as.numeric(NA),
                 Spec_imp = as.numeric(NA),
                 Spec_not = as.numeric(NA),
                 Spec_det = as.numeric(NA),
                 Sensitivity_cwa = as.numeric(NA),
                 Specificity_cwa = as.numeric(NA),
                 SenSpec_mean = as.numeric(NA),
                 Accuracy_PercAgree = as.numeric(NA),
                 Kappa = as.numeric(NA))

for (i in 1:nrow(SenSpezSumm)) {
  SenSpezSumm[i,"Sens_imp"] = ClassEval[[i]][["senspez"]]$Sensitivity[1]
  SenSpezSumm[i,"Sens_not"] = ClassEval[[i]][["senspez"]]$Sensitivity[2]
  SenSpezSumm[i,"Sens_det"] = ClassEval[[i]][["senspez"]]$Sensitivity[3]
  
  SenSpezSumm[i,"Spec_imp"] = ClassEval[[i]][["senspez"]]$Specificity[1]
  SenSpezSumm[i,"Spec_not"] = ClassEval[[i]][["senspez"]]$Specificity[2]
  SenSpezSumm[i,"Spec_det"] = ClassEval[[i]][["senspez"]]$Specificity[3]
  
  SenSpezSumm[i,"Sensitivity_cwa"] = ClassEval[[i]][["senspez_cwa"]]$Sensitivity_cwa
  SenSpezSumm[i,"Specificity_cwa"] = ClassEval[[i]][["senspez_cwa"]]$Specificity_cwa
  SenSpezSumm[i,"SenSpec_mean"] = ClassEval[[i]][["senspez_cwa"]]$GMean_SenSpez
  
  SenSpezSumm[i,"Accuracy_PercAgree"] = ClassEval[[i]][["agreement"]][[1]]
  SenSpezSumm[i,"Kappa"] = ClassEval[[i]][["agreement"]][[2]]
}

#save(SenSpezSumm, file = "cor_04_k20/EMA_SenSpezSumm.RData")
#load("cor_04_k20/EMA_SenSpezSumm.RData")

SenSpezSumm %>% 
  mutate(across(.cols = where(is.numeric), .fns = round, digits = 2)) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
Frequency Method Sens_imp Sens_not Sens_det Spec_imp Spec_not Spec_det Sensitivity_cwa Specificity_cwa SenSpec_mean Accuracy_PercAgree Kappa
30.30 Mean_PC_30.30 1.00 0.93 1.00 0.93 1.00 1.00 0.98 0.98 0.98 0.94 0.84
30.30 RCI_ind_preSD_30.30 0.84 0.87 0.47 0.88 0.83 1.00 0.70 0.90 0.79 0.86 0.61
30.30 RCI_ind_pooledSD_30.30 0.88 0.94 0.17 0.94 0.85 1.00 0.52 0.93 0.69 0.92 0.75
30.30 EN_30.30 1.00 0.65 0.25 0.65 0.97 1.00 0.55 0.86 0.69 0.71 0.40
30.30 CSI_30.30 1.00 1.00 1.00 1.00 1.00 1.00 1.00 1.00 1.00 1.00 1.00
5.5 Mean_PC_5.5_Window 0.86 0.86 0.69 0.88 0.85 0.99 0.80 0.90 0.85 0.86 0.62
5.5 RCI_ind_preSD_5.5_Window 0.74 0.84 0.49 0.85 0.73 0.99 0.67 0.85 0.76 0.82 0.50
5.5 RCI_ind_pooledSD_5.5_Window 0.76 0.90 0.15 0.90 0.74 1.00 0.47 0.87 0.64 0.87 0.60
5.5 EN_5.5_Window 0.98 0.64 0.20 0.65 0.95 1.00 0.50 0.85 0.65 0.70 0.38
5.5 CSI_5.5_Window 0.81 0.93 0.69 0.94 0.80 0.99 0.80 0.91 0.85 0.91 0.71
5.5 Mean_PC_5.5_Days 0.83 0.81 0.81 0.84 0.83 0.98 0.82 0.88 0.85 0.82 0.53
5.5 RCI_ind_preSD_5.5_Days 0.76 0.79 0.56 0.81 0.75 0.99 0.70 0.84 0.77 0.78 0.44
5.5 RCI_ind_pooledSD_5.5_Days 0.76 0.86 0.37 0.86 0.75 0.99 0.62 0.86 0.73 0.84 0.53
5.5 EN_5.5_Days 0.97 0.59 0.53 0.61 0.95 0.99 0.67 0.83 0.75 0.66 0.34
5.5 CSI_5.5_Days 0.77 0.89 0.75 0.91 0.76 0.98 0.80 0.88 0.84 0.87 0.61
SenSpezSumm %>% 
  ggplot(aes(x = Method, weight = Sensitivity_cwa)) + 
  geom_bar(fill = "#0c4c8a") + 
  coord_flip() + 
  theme_bw() + 
  labs(y = "Sensitivity to Change (Reference = CSI_30.30)")#<<
#ggsave("Plots/k20_EMA_Sensitivity_Barplot.jpg", width = 6, height = 4)#<<

SenSpezSumm %>% 
  ggplot(aes(x = Method, weight = Specificity_cwa)) + 
  geom_bar(fill = "#0c4c8a") + 
  coord_flip() + 
  theme_bw() + 
  labs(y = "Specificity to Change (Reference = CSI_30.30)")#<<
#ggsave("Plots/k20_EMA_Specificity_Barplot.jpg", width = 6, height = 4)#<<

SenSpezSumm %>% 
  ggplot(aes(x = Method, weight = SenSpec_mean)) + 
  geom_bar(fill = "#0c4c8a") + 
  coord_flip() + 
  theme_bw() + 
  labs(y = "Mean of Sensitivity and Specificity (Reference = CSI_30.30)")#<<
#ggsave("Plots/k20_EMA_SenSpec-Mean_Barplot.jpg", width = 6, height = 4)#<<

SenSpezSumm %>% 
  ggplot(aes(x = Method, weight = Accuracy_PercAgree)) + 
  geom_bar(fill = "#0c4c8a") + 
  coord_flip() + 
  theme_bw() + 
  labs(y = "Accuracy = Percentage Agreement (Reference = CSI_30.30)")#<<
#ggsave("Plots/k20_EMA_PercAgree_Barplot.jpg", width = 6, height = 4)#<<

SenSpezSumm %>% 
  ggplot(aes(x = Method, weight = Kappa)) + 
  geom_bar(fill = "#0c4c8a") + 
  coord_flip() + 
  theme_bw() + 
  labs(y = "Agreement: Cohen´s Kappa (Reference = CSI_30.30)")#<<
#ggsave("Plots/k20_EMA_Kappa_Barplot.jpg", width = 6, height = 4)#<<



df = SenSpezSumm %>% 
  pivot_longer(cols = Sens_imp:Kappa, names_to = "Index", values_to = "Estimate") %>% 
  mutate(Method = as_factor(Method), Index = as_factor(Index))#<<

#ggplot(df) +
# aes(x = Method, colour = Index, weight = Estimate) +
# geom_bar(position = "dodge", fill = "#0c4c8a") +
# scale_color_hue() +
# theme_gray()#<<
#ggsave("Plots/k20_EMA_Class_Evaluation_by_Methods.jpg", width = 6, height = 4)#<<


Sensitivität & Spezifität gegenüber Veränderung:
Evaluation der Veränderungs-Klassifikationen der Klassifikationsmethoden within-method, between-frequencies, jeweils mit den Klassifikationen der Methode im 30-MZP-Szenario als Referenz:

#load("cor_04_k20/EMA_Class.RData")

########## Agreement between Mean PCs in 30-fold, 5-fold Random Window and 5-fold Random Days assessment frequencies
EMA_Class_PC = EMA_Class %>% select(Mean_PC_30.30,Mean_PC_5.5_Window,Mean_PC_5.5_Days)
ClassEval_PC = list()
for (i in 1:ncol(EMA_Class_PC)) {
  x = eval(parse(text = paste0("EMA_Class_PC$", colnames(EMA_Class_PC[,i]))))
  cm = confusionMatrix(x, reference = EMA_Class_PC$Mean_PC_30.30, 
                       dnn = c(paste0("EMA_Class_PC$", names(EMA_Class_PC[,i])), "Mean PC 30.30"), mode = "everything")
  cm$agreement = cm$overall[c("Accuracy","Kappa")]
  cm$senspez = cm$byClass %>% 
    as_tibble() %>% 
    select(Sensitivity, Specificity)
  
  cm$senspez_cwa = cm$senspez %>% 
    summarise(across(.cols = everything(), .fns = geometric.mean, .names = "{.col}_cwa")) %>% 
    mutate(GMean_SenSpez = geometric.mean(c(Sensitivity_cwa, Specificity_cwa)))
  
  ClassEval_PC[[paste0(names(EMA_Class_PC[,i]))]] = cm[c("table","agreement","senspez","senspez_cwa")]
}

#save(ClassEval_PC, file = "cor_04_k20/EMA_ClassEval_PC.RData")
#load("cor_04_k20/EMA_ClassEval_PC.RData")

SenSpezSumm_PC = tibble(Frequency = as.factor(c("30.30","5.5 Window","5.5 Days")),
                 Method = colnames(EMA_Class_PC),
                 Sens_imp = as.numeric(NA),
                 Sens_not = as.numeric(NA),
                 Sens_det = as.numeric(NA),
                 Spec_imp = as.numeric(NA),
                 Spec_not = as.numeric(NA),
                 Spec_det = as.numeric(NA),
                 Sensitivity_cwa = as.numeric(NA),
                 Specificity_cwa = as.numeric(NA),
                 SenSpec_mean = as.numeric(NA),
                 Accuracy_PercAgree = as.numeric(NA),
                 Kappa = as.numeric(NA))

for (i in 1:nrow(SenSpezSumm_PC)) {
  SenSpezSumm_PC[i,"Sens_imp"] = ClassEval_PC[[i]][["senspez"]]$Sensitivity[1]
  SenSpezSumm_PC[i,"Sens_not"] = ClassEval_PC[[i]][["senspez"]]$Sensitivity[2]
  SenSpezSumm_PC[i,"Sens_det"] = ClassEval_PC[[i]][["senspez"]]$Sensitivity[3]
  
  SenSpezSumm_PC[i,"Spec_imp"] = ClassEval_PC[[i]][["senspez"]]$Specificity[1]
  SenSpezSumm_PC[i,"Spec_not"] = ClassEval_PC[[i]][["senspez"]]$Specificity[2]
  SenSpezSumm_PC[i,"Spec_det"] = ClassEval_PC[[i]][["senspez"]]$Specificity[3]
  
  SenSpezSumm_PC[i,"Sensitivity_cwa"] = ClassEval_PC[[i]][["senspez_cwa"]]$Sensitivity_cwa
  SenSpezSumm_PC[i,"Specificity_cwa"] = ClassEval_PC[[i]][["senspez_cwa"]]$Specificity_cwa
  SenSpezSumm_PC[i,"SenSpec_mean"] = ClassEval_PC[[i]][["senspez_cwa"]]$GMean_SenSpez
  
  SenSpezSumm_PC[i,"Accuracy_PercAgree"] = ClassEval_PC[[i]][["agreement"]][[1]]
  SenSpezSumm_PC[i,"Kappa"] = ClassEval_PC[[i]][["agreement"]][[2]]
}

#save(SenSpezSumm_PC, file = "cor_04_k20/EMA_SenSpezSumm_PC.RData")
#load("cor_04_k20/EMA_SenSpezSumm_PC.RData")

SenSpezSumm_PC %>% 
  mutate(across(.cols = where(is.numeric), .fns = round, digits = 2)) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
Frequency Method Sens_imp Sens_not Sens_det Spec_imp Spec_not Spec_det Sensitivity_cwa Specificity_cwa SenSpec_mean Accuracy_PercAgree Kappa
30.30 Mean_PC_30.30 1.00 1.00 1.0 1.00 1.00 1.00 1.00 1.00 1.00 1.00 1.00
5.5 Window Mean_PC_5.5_Window 0.86 0.92 0.7 0.93 0.85 0.99 0.82 0.92 0.87 0.90 0.74
5.5 Days Mean_PC_5.5_Days 0.83 0.86 0.7 0.89 0.83 0.98 0.79 0.90 0.84 0.85 0.64
########## Agreement between CSI(PC)s in 30-fold, 5-fold Random Window and 5-fold Random Days assessment frequencies
EMA_Class_CSI = EMA_Class %>% select(CSI_30.30,CSI_5.5_Window,CSI_5.5_Days)
ClassEval_CSI = list()
for (i in 1:ncol(EMA_Class_CSI)) {
  x = eval(parse(text = paste0("EMA_Class_CSI$", colnames(EMA_Class_CSI[,i]))))
  cm = confusionMatrix(x, reference = EMA_Class_CSI$CSI_30.30, 
                       dnn = c(paste0("EMA_Class_CSI$", names(EMA_Class_CSI[,i])), "CSI Mean PC 30.30"), mode = "everything")
  cm$agreement = cm$overall[c("Accuracy","Kappa")]
  cm$senspez = cm$byClass %>% 
    as_tibble() %>% 
    select(Sensitivity, Specificity)
  
  cm$senspez_cwa = cm$senspez %>% 
    summarise(across(.cols = everything(), .fns = geometric.mean, .names = "{.col}_cwa")) %>% 
    mutate(GMean_SenSpez = geometric.mean(c(Sensitivity_cwa, Specificity_cwa)))
  
  ClassEval_CSI[[paste0(names(EMA_Class_CSI[,i]))]] = cm[c("table","agreement","senspez","senspez_cwa")]
}

#save(ClassEval_CSI, file = "cor_04_k20/EMA_ClassEval_CSI.RData")
#load("cor_04_k20/EMA_ClassEval_CSI.RData")

SenSpezSumm_CSI = tibble(Frequency = as.factor(c("30.30","5.5 Window","5.5 Days")),
                 Method = colnames(EMA_Class_CSI),
                 Sens_imp = as.numeric(NA),
                 Sens_not = as.numeric(NA),
                 Sens_det = as.numeric(NA),
                 Spec_imp = as.numeric(NA),
                 Spec_not = as.numeric(NA),
                 Spec_det = as.numeric(NA),
                 Sensitivity_cwa = as.numeric(NA),
                 Specificity_cwa = as.numeric(NA),
                 SenSpec_mean = as.numeric(NA),
                 Accuracy_PercAgree = as.numeric(NA),
                 Kappa = as.numeric(NA))

for (i in 1:nrow(SenSpezSumm_CSI)) {
  SenSpezSumm_CSI[i,"Sens_imp"] = ClassEval_CSI[[i]][["senspez"]]$Sensitivity[1]
  SenSpezSumm_CSI[i,"Sens_not"] = ClassEval_CSI[[i]][["senspez"]]$Sensitivity[2]
  SenSpezSumm_CSI[i,"Sens_det"] = ClassEval_CSI[[i]][["senspez"]]$Sensitivity[3]
  
  SenSpezSumm_CSI[i,"Spec_imp"] = ClassEval_CSI[[i]][["senspez"]]$Specificity[1]
  SenSpezSumm_CSI[i,"Spec_not"] = ClassEval_CSI[[i]][["senspez"]]$Specificity[2]
  SenSpezSumm_CSI[i,"Spec_det"] = ClassEval_CSI[[i]][["senspez"]]$Specificity[3]
  
  SenSpezSumm_CSI[i,"Sensitivity_cwa"] = ClassEval_CSI[[i]][["senspez_cwa"]]$Sensitivity_cwa
  SenSpezSumm_CSI[i,"Specificity_cwa"] = ClassEval_CSI[[i]][["senspez_cwa"]]$Specificity_cwa
  SenSpezSumm_CSI[i,"SenSpec_mean"] = ClassEval_CSI[[i]][["senspez_cwa"]]$GMean_SenSpez
  
  SenSpezSumm_CSI[i,"Accuracy_PercAgree"] = ClassEval_CSI[[i]][["agreement"]][[1]]
  SenSpezSumm_CSI[i,"Kappa"] = ClassEval_CSI[[i]][["agreement"]][[2]]
}

#save(SenSpezSumm_CSI, file = "cor_04_k20/EMA_SenSpezSumm_CSI.RData")
#load("cor_04_k20/EMA_SenSpezSumm_CSI.RData")

SenSpezSumm_CSI %>% 
  mutate(across(.cols = where(is.numeric), .fns = round, digits = 2)) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
Frequency Method Sens_imp Sens_not Sens_det Spec_imp Spec_not Spec_det Sensitivity_cwa Specificity_cwa SenSpec_mean Accuracy_PercAgree Kappa
30.30 CSI_30.30 1.00 1.00 1.00 1.00 1.00 1.00 1.0 1.00 1.00 1.00 1.00
5.5 Window CSI_5.5_Window 0.81 0.93 0.69 0.94 0.80 0.99 0.8 0.91 0.85 0.91 0.71
5.5 Days CSI_5.5_Days 0.77 0.89 0.75 0.91 0.76 0.98 0.8 0.88 0.84 0.87 0.61
########## Agreement between RCIs (ind.) in 30-fold, 5-fold Random Window and 5-fold Random Days assessment frequencies
EMA_Class_RCI = EMA_Class %>% select(RCI_ind_preSD_30.30,RCI_ind_preSD_5.5_Window,RCI_ind_preSD_5.5_Days)
ClassEval_RCI = list()
for (i in 1:ncol(EMA_Class_RCI)) {
  x = eval(parse(text = paste0("EMA_Class_RCI$", colnames(EMA_Class_RCI[,i]))))
  cm = confusionMatrix(x, reference = EMA_Class_RCI$RCI_ind_preSD_30.30, 
                       dnn = c(paste0("EMA_Class_RCI$", names(EMA_Class_RCI[,i])), "RCI ind pre-SD 30.30"), mode = "everything")
  cm$agreement = cm$overall[c("Accuracy","Kappa")]
  cm$senspez = cm$byClass %>% 
    as_tibble() %>% 
    select(Sensitivity, Specificity)
  
  cm$senspez_cwa = cm$senspez %>% 
    summarise(across(.cols = everything(), .fns = geometric.mean, .names = "{.col}_cwa")) %>% 
    mutate(GMean_SenSpez = geometric.mean(c(Sensitivity_cwa, Specificity_cwa)))
  
  ClassEval_RCI[[paste0(names(EMA_Class_RCI[,i]))]] = cm[c("table","agreement","senspez","senspez_cwa")]
}

#save(ClassEval_RCI, file = "cor_04_k20/EMA_ClassEval_RCI.RData")
#load("cor_04_k20/EMA_ClassEval_RCI.RData")

SenSpezSumm_RCI = tibble(Frequency = as.factor(c("30.30","5.5 Window","5.5 Days")),
                 Method = colnames(EMA_Class_RCI),
                 Sens_imp = as.numeric(NA),
                 Sens_not = as.numeric(NA),
                 Sens_det = as.numeric(NA),
                 Spec_imp = as.numeric(NA),
                 Spec_not = as.numeric(NA),
                 Spec_det = as.numeric(NA),
                 Sensitivity_cwa = as.numeric(NA),
                 Specificity_cwa = as.numeric(NA),
                 SenSpec_mean = as.numeric(NA),
                 Accuracy_PercAgree = as.numeric(NA),
                 Kappa = as.numeric(NA))

for (i in 1:nrow(SenSpezSumm_RCI)) {
  SenSpezSumm_RCI[i,"Sens_imp"] = ClassEval_RCI[[i]][["senspez"]]$Sensitivity[1]
  SenSpezSumm_RCI[i,"Sens_not"] = ClassEval_RCI[[i]][["senspez"]]$Sensitivity[2]
  SenSpezSumm_RCI[i,"Sens_det"] = ClassEval_RCI[[i]][["senspez"]]$Sensitivity[3]
  
  SenSpezSumm_RCI[i,"Spec_imp"] = ClassEval_RCI[[i]][["senspez"]]$Specificity[1]
  SenSpezSumm_RCI[i,"Spec_not"] = ClassEval_RCI[[i]][["senspez"]]$Specificity[2]
  SenSpezSumm_RCI[i,"Spec_det"] = ClassEval_RCI[[i]][["senspez"]]$Specificity[3]
  
  SenSpezSumm_RCI[i,"Sensitivity_cwa"] = ClassEval_RCI[[i]][["senspez_cwa"]]$Sensitivity_cwa
  SenSpezSumm_RCI[i,"Specificity_cwa"] = ClassEval_RCI[[i]][["senspez_cwa"]]$Specificity_cwa
  SenSpezSumm_RCI[i,"SenSpec_mean"] = ClassEval_RCI[[i]][["senspez_cwa"]]$GMean_SenSpez
  
  SenSpezSumm_RCI[i,"Accuracy_PercAgree"] = ClassEval_RCI[[i]][["agreement"]][[1]]
  SenSpezSumm_RCI[i,"Kappa"] = ClassEval_RCI[[i]][["agreement"]][[2]]
}

#save(SenSpezSumm_RCI, file = "cor_04_k20/EMA_SenSpezSumm_RCI.RData")
#load("cor_04_k20/EMA_SenSpezSumm_RCI.RData")

SenSpezSumm_RCI %>% 
  mutate(across(.cols = where(is.numeric), .fns = round, digits = 2)) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
Frequency Method Sens_imp Sens_not Sens_det Spec_imp Spec_not Spec_det Sensitivity_cwa Specificity_cwa SenSpec_mean Accuracy_PercAgree Kappa
30.30 RCI_ind_preSD_30.30 1.00 1.00 1.00 1.00 1.00 1.00 1.00 1.00 1.00 1.00 1.00
5.5 Window RCI_ind_preSD_5.5_Window 0.80 0.92 0.74 0.93 0.80 0.99 0.82 0.90 0.86 0.89 0.72
5.5 Days RCI_ind_preSD_5.5_Days 0.79 0.86 0.63 0.88 0.79 0.99 0.75 0.88 0.81 0.84 0.61

1.14 Jackknife-Methode zum Resampling von Messzeitpunkten

Statt wenige zufällige MZP-Kombinationen zu ziehen und diese dann mit den “wahren” Schätzwerten und Klassifikationen (= berechnet anhand der gesamten Intervalle mit je 30 MZP) zu vergleichen, sollen die empirische Verteilung der Parameter und somit der Schätzfehler über Resampling-Methoden wie Jackknife-Verfahren und Bootstrapping berechnet werden.

Percentage Change (PC)

###### EMA_30.30
n = 30

Mean_PC = function(x, ID_df) {(1-((mean(ID_df[x,2])) / (mean(ID_df[x,1])))) * 100}

for (i in 1:nrow(EMA_30.30)) {
  df = data.frame(PRE = as.numeric(EMA_30.30[i,pre_30mzp]), POST = as.numeric(EMA_30.30[i,post_30mzp]))
  
  EMA_30.30[i,"Mean_PC_jse"] = jackknife(1:n, Mean_PC, df)$jack.se
  EMA_30.30[i,"Mean_PC_jbias"] = jackknife(1:n, Mean_PC, df)$jack.bias
  message(i)
}

EMA_30.30_Mean_PC_JK = EMA_30.30 %>% 
  select(ID, Mean_PC_jse, Mean_PC_jbias)
save(EMA_30.30_Mean_PC_JK, file = "Jackknife/EMA_30.30_Mean_PC_JK_k20.RData")

###### EMA_5.5_Window
n = 5

Mean_PC = function(x, ID_df) {(1-((mean(ID_df[x,2])) / (mean(ID_df[x,1])))) * 100}

for (i in 1:nrow(EMA_5.5_Window)) {
  df = data.frame(PRE = as.numeric(EMA_5.5_Window[i,pre_5mzp]), POST = as.numeric(EMA_5.5_Window[i,post_5mzp]))
  
  EMA_5.5_Window[i,"Mean_PC_jse"] = jackknife(1:n, Mean_PC, df)$jack.se
  EMA_5.5_Window[i,"Mean_PC_jbias"] = jackknife(1:n, Mean_PC, df)$jack.bias
  message(i)
}

EMA_5.5_Window_Mean_PC_JK = EMA_5.5_Window %>% 
  select(ID, Mean_PC_jse, Mean_PC_jbias)
save(EMA_5.5_Window_Mean_PC_JK, file = "Jackknife/EMA_5.5_Window_Mean_PC_JK_k20.RData")

###### EMA_5.5_Days
n = 5

Mean_PC = function(x, ID_df) {(1-((mean(ID_df[x,2])) / (mean(ID_df[x,1])))) * 100}

for (i in 1:nrow(EMA_5.5_Days)) {
  df = data.frame(PRE = as.numeric(EMA_5.5_Days[i,pre_5mzp]), POST = as.numeric(EMA_5.5_Days[i,post_5mzp]))
  
  EMA_5.5_Days[i,"Mean_PC_jse"] = jackknife(1:n, Mean_PC, df)$jack.se
  EMA_5.5_Days[i,"Mean_PC_jbias"] = jackknife(1:n, Mean_PC, df)$jack.bias
  message(i)
}

EMA_5.5_Days_Mean_PC_JK = EMA_5.5_Days %>% 
  select(ID, Mean_PC_jse, Mean_PC_jbias)
save(EMA_5.5_Days_Mean_PC_JK, file = "Jackknife/EMA_5.5_Days_Mean_PC_JK_k20.RData")
load("Jackknife/EMA_30.30_Mean_PC_JK_k20.RData")
load("Jackknife/EMA_5.5_Window_Mean_PC_JK_k20.RData")
load("Jackknife/EMA_5.5_Days_Mean_PC_JK_k20.RData")

EMA_30.30 = full_join(EMA_30.30, EMA_30.30_Mean_PC_JK, by = "ID")
EMA_5.5_Window = full_join(EMA_5.5_Window, EMA_5.5_Window_Mean_PC_JK, by = "ID")
EMA_5.5_Days = full_join(EMA_5.5_Days, EMA_5.5_Days_Mean_PC_JK, by = "ID")

temp = tibble(Jackknife_SE = c(EMA_30.30$Mean_PC_jse, EMA_5.5_Window$Mean_PC_jse, EMA_5.5_Days$Mean_PC_jse),
              Datasets = as_factor(rep(c("EMA_30.30", "EMA_5.5_Window", "EMA_5.5_Days"), each = length(EMA_30.30$Mean_PC_jse))))#<<

temp %>%
  ggplot(aes(x = Jackknife_SE, fill = Datasets)) +
  geom_histogram(alpha = 0.2, position = "identity") +
  labs(x = "Jackknife SE of Mean Percentage Change", y = "Cases") +
  theme_gray()#<<

#ggsave("Plots/k20_EMA_Mean_PC_JK_SE.jpg", width = 6, height = 4)#<<

temp %>% 
  ggplot(aes(x = Datasets, y = Jackknife_SE)) +
  geom_boxplot(fill = "dodgerblue", na.rm = TRUE, outlier.size = 1) +
  labs(x = "Dataset", y = "Jackknife SE of Mean Percentage Change") +
  theme_gray()#<<

#ggsave("Plots/k20_EMA_Mean_PC_JK_SE_Box.jpg", width = 6, height = 4)#<<


temp = tibble(Jackknife_Bias = c(EMA_30.30$Mean_PC_jbias, EMA_5.5_Window$Mean_PC_jbias, EMA_5.5_Days$Mean_PC_jbias),
              Datasets = as_factor(rep(c("EMA_30.30", "EMA_5.5_Window", "EMA_5.5_Days"), each = length(EMA_30.30$Mean_PC_jbias))))#<<

temp %>%
  ggplot(aes(x = Jackknife_Bias, fill = Datasets)) +
  geom_histogram(alpha = 0.2, position = "identity") +
  labs(x = "Jackknife Bias of Mean Percentage Change", y = "Cases") +
  theme_gray()#<<

#ggsave("Plots/k20_EMA_Mean_PC_JK_Bias.jpg", width = 6, height = 4)#<<

#temp %>% 
#  ggplot(aes(x = Datasets, y = Jackknife_Bias)) +
#  geom_boxplot(fill = "dodgerblue", na.rm = TRUE, outlier.size = 1) +
#  labs(x = "Dataset", y = "Jackknife Bias of Mean Percentage Change") +
#  theme_gray()#<<
#ggsave("Plots/k20_EMA_Mean_PC_JK_Bias_Box.jpg", width = 6, height = 4)#<<

RCI(ind) nur mit SD aus dem individuellen Pre-Intervall

###### EMA_30.30
n = 30

RCI_ind_preSD = function(x, ID_df) {(mean(ID_df[x,2]) - mean(ID_df[x,1])) / 
    sqrt(2 * (sd(ID_df[x,1]) * sqrt(1 - EMA_5.5_Alpha))^2)}

for (i in 1:nrow(EMA_30.30)) {
  df = data.frame(PRE = as.numeric(EMA_30.30[i,pre_30mzp]), POST = as.numeric(EMA_30.30[i,post_30mzp]))
  
  EMA_30.30[i,"RCI_ind_preSD_jse"] = jackknife(1:n, RCI_ind_preSD, df)$jack.se
  EMA_30.30[i,"RCI_ind_preSD_jbias"] = jackknife(1:n, RCI_ind_preSD, df)$jack.bias
  message(i)
}

EMA_30.30_RCI_ind_preSD_JK = EMA_30.30 %>% 
  select(ID, RCI_ind_preSD_jse, RCI_ind_preSD_jbias)
save(EMA_30.30_RCI_ind_preSD_JK, file = "Jackknife/EMA_30.30_RCI_ind_preSD_JK_k20.RData")

###### EMA_5.5_Window
n = 5

RCI_ind_preSD = function(x, ID_df) {(mean(ID_df[x,2]) - mean(ID_df[x,1])) / 
    sqrt(2 * (sd(ID_df[x,1]) * sqrt(1 - EMA_5.5_Alpha))^2)}

for (i in 1:nrow(EMA_5.5_Window)) {
  df = data.frame(PRE = as.numeric(EMA_5.5_Window[i,pre_5mzp]), POST = as.numeric(EMA_5.5_Window[i,post_5mzp]))
  
  EMA_5.5_Window[i,"RCI_ind_preSD_jse"] = jackknife(1:n, RCI_ind_preSD, df)$jack.se
  EMA_5.5_Window[i,"RCI_ind_preSD_jbias"] = jackknife(1:n, RCI_ind_preSD, df)$jack.bias
  message(i)
}

EMA_5.5_Window_RCI_ind_preSD_JK = EMA_5.5_Window %>% 
  select(ID, RCI_ind_preSD_jse, RCI_ind_preSD_jbias)
save(EMA_5.5_Window_RCI_ind_preSD_JK, file = "Jackknife/EMA_5.5_Window_RCI_ind_preSD_JK_k20.RData")

###### EMA_5.5_Days
n = 5

RCI_ind_preSD = function(x, ID_df) {(mean(ID_df[x,2]) - mean(ID_df[x,1])) / 
    sqrt(2 * (sd(ID_df[x,1]) * sqrt(1 - EMA_5.5_Alpha))^2)}

for (i in 1:nrow(EMA_5.5_Days)) {
  df = data.frame(PRE = as.numeric(EMA_5.5_Days[i,pre_5mzp]), POST = as.numeric(EMA_5.5_Days[i,post_5mzp]))
  
  EMA_5.5_Days[i,"RCI_ind_preSD_jse"] = jackknife(1:n, RCI_ind_preSD, df)$jack.se
  EMA_5.5_Days[i,"RCI_ind_preSD_jbias"] = jackknife(1:n, RCI_ind_preSD, df)$jack.bias
  message(i)
}

EMA_5.5_Days_RCI_ind_preSD_JK = EMA_5.5_Days %>% 
  select(ID, RCI_ind_preSD_jse, RCI_ind_preSD_jbias)
save(EMA_5.5_Days_RCI_ind_preSD_JK, file = "Jackknife/EMA_5.5_Days_RCI_ind_preSD_JK_k20.RData")
load("Jackknife/EMA_30.30_RCI_ind_preSD_JK_k20.RData")
load("Jackknife/EMA_5.5_Window_RCI_ind_preSD_JK_k20.RData")
load("Jackknife/EMA_5.5_Days_RCI_ind_preSD_JK_k20.RData")

EMA_30.30 = full_join(EMA_30.30, EMA_30.30_RCI_ind_preSD_JK, by = "ID")
EMA_5.5_Window = full_join(EMA_5.5_Window, EMA_5.5_Window_RCI_ind_preSD_JK, by = "ID")
EMA_5.5_Days = full_join(EMA_5.5_Days, EMA_5.5_Days_RCI_ind_preSD_JK, by = "ID")

temp = tibble(Jackknife_SE = c(EMA_30.30$RCI_ind_preSD_jse, EMA_5.5_Window$RCI_ind_preSD_jse, EMA_5.5_Days$RCI_ind_preSD_jse),
              Datasets = as_factor(rep(c("EMA_30.30", "EMA_5.5_Window", "EMA_5.5_Days"), each = length(EMA_30.30$RCI_ind_preSD_jse))))#<<

temp %>%
  ggplot(aes(x = Jackknife_SE, fill = Datasets)) +
  geom_histogram(alpha = 0.2, position = "identity") +
  labs(x = "Jackknife SE of RCI(ind) With Pre-SDs", y = "Cases") +
  theme_gray()#<<

#ggsave("Plots/k20_EMA_RCI_ind_preSD_JK_SE.jpg", width = 6, height = 4)#<<

temp %>% 
  ggplot(aes(x = Datasets, y = Jackknife_SE)) +
  geom_boxplot(fill = "dodgerblue", na.rm = TRUE, outlier.size = 1) +
  labs(x = "Dataset", y = "Jackknife SE of RCI(ind) With Pre-SDs") +
  theme_gray()#<<

#ggsave("Plots/k20_EMA_RCI_ind_preSD_JK_SE_Box.jpg", width = 6, height = 4)#<<


temp = tibble(Jackknife_Bias = c(EMA_30.30$RCI_ind_preSD_jbias, EMA_5.5_Window$RCI_ind_preSD_jbias,
                                 EMA_5.5_Days$RCI_ind_preSD_jbias),
              Datasets = as_factor(rep(c("EMA_30.30", "EMA_5.5_Window", "EMA_5.5_Days"), 
                                       each = length(EMA_30.30$RCI_ind_preSD_jbias))))#<<

temp %>%
  ggplot(aes(x = Jackknife_Bias, fill = Datasets)) +
  geom_histogram(alpha = 0.2, position = "identity") +
  labs(x = "Jackknife Bias of RCI(ind) With Pre-SDs", y = "Cases") +
  theme_gray()#<<

#ggsave("Plots/k20_EMA_RCI_ind_preSD_JK_Bias.jpg", width = 6, height = 4)#<<

#temp %>% 
#  ggplot(aes(x = Datasets, y = Jackknife_Bias)) +
#  geom_boxplot(fill = "dodgerblue", na.rm = TRUE, outlier.size = 1) +
#  labs(x = "Dataset", y = "Jackknife Bias of RCI(ind) With Pre-SDs") +
#  theme_gray()#<<
#ggsave("Plots/k20_EMA_RCI_ind_preSD_JK_Bias_Box.jpg", width = 6, height = 4)#<<

RCI(ind) mit pooled SDs aus beiden individuellen Intervallen

###### EMA_30.30
n = 30

RCI_ind_pooledSD = function(x, ID_df) {(mean(ID_df[x,2]) - mean(ID_df[x,1])) / 
    sqrt((sd(ID_df[x,1])^ 2 + sd(ID_df[x,2])^ 2) * (1 - EMA_5.5_Alpha))}

for (i in 1:nrow(EMA_30.30)) {
  df = data.frame(PRE = as.numeric(EMA_30.30[i,pre_30mzp]), POST = as.numeric(EMA_30.30[i,post_30mzp]))
  
  EMA_30.30[i,"RCI_ind_pooledSD_jse"] = jackknife(1:n, RCI_ind_pooledSD, df)$jack.se
  EMA_30.30[i,"RCI_ind_pooledSD_jbias"] = jackknife(1:n, RCI_ind_pooledSD, df)$jack.bias
  message(i)
}

EMA_30.30_RCI_ind_pooledSD_JK = EMA_30.30 %>% 
  select(ID, RCI_ind_pooledSD_jse, RCI_ind_pooledSD_jbias)
save(EMA_30.30_RCI_ind_pooledSD_JK, file = "Jackknife/EMA_30.30_RCI_ind_pooledSD_JK_k20.RData")

###### EMA_5.5_Window
n = 5

RCI_ind_pooledSD = function(x, ID_df) {(mean(ID_df[x,2]) - mean(ID_df[x,1])) / 
    sqrt((sd(ID_df[x,1])^ 2 + sd(ID_df[x,2])^ 2) * (1 - EMA_5.5_Alpha))}

for (i in 1:nrow(EMA_5.5_Window)) {
  df = data.frame(PRE = as.numeric(EMA_5.5_Window[i,pre_5mzp]), POST = as.numeric(EMA_5.5_Window[i,post_5mzp]))
  
  EMA_5.5_Window[i,"RCI_ind_pooledSD_jse"] = jackknife(1:n, RCI_ind_pooledSD, df)$jack.se
  EMA_5.5_Window[i,"RCI_ind_pooledSD_jbias"] = jackknife(1:n, RCI_ind_pooledSD, df)$jack.bias
  message(i)
}

EMA_5.5_Window_RCI_ind_pooledSD_JK = EMA_5.5_Window %>% 
  select(ID, RCI_ind_pooledSD_jse, RCI_ind_pooledSD_jbias)
save(EMA_5.5_Window_RCI_ind_pooledSD_JK, file = "Jackknife/EMA_5.5_Window_RCI_ind_pooledSD_JK_k20.RData")

###### EMA_5.5_Days
n = 5

RCI_ind_pooledSD = function(x, ID_df) {(mean(ID_df[x,2]) - mean(ID_df[x,1])) / 
    sqrt((sd(ID_df[x,1])^ 2 + sd(ID_df[x,2])^ 2) * (1 - EMA_5.5_Alpha))}

for (i in 1:nrow(EMA_5.5_Days)) {
  df = data.frame(PRE = as.numeric(EMA_5.5_Days[i,pre_5mzp]), POST = as.numeric(EMA_5.5_Days[i,post_5mzp]))
  
  EMA_5.5_Days[i,"RCI_ind_pooledSD_jse"] = jackknife(1:n, RCI_ind_pooledSD, df)$jack.se
  EMA_5.5_Days[i,"RCI_ind_pooledSD_jbias"] = jackknife(1:n, RCI_ind_pooledSD, df)$jack.bias
  message(i)
}

EMA_5.5_Days_RCI_ind_pooledSD_JK = EMA_5.5_Days %>% 
  select(ID, RCI_ind_pooledSD_jse, RCI_ind_pooledSD_jbias)
save(EMA_5.5_Days_RCI_ind_pooledSD_JK, file = "Jackknife/EMA_5.5_Days_RCI_ind_pooledSD_JK_k20.RData")
load("Jackknife/EMA_30.30_RCI_ind_pooledSD_JK_k20.RData")
load("Jackknife/EMA_5.5_Window_RCI_ind_pooledSD_JK_k20.RData")
load("Jackknife/EMA_5.5_Days_RCI_ind_pooledSD_JK_k20.RData")

EMA_30.30 = full_join(EMA_30.30, EMA_30.30_RCI_ind_pooledSD_JK, by = "ID")
EMA_5.5_Window = full_join(EMA_5.5_Window, EMA_5.5_Window_RCI_ind_pooledSD_JK, by = "ID")
EMA_5.5_Days = full_join(EMA_5.5_Days, EMA_5.5_Days_RCI_ind_pooledSD_JK, by = "ID")

temp = tibble(Jackknife_SE = c(EMA_30.30$RCI_ind_pooledSD_jse, EMA_5.5_Window$RCI_ind_pooledSD_jse,
                               EMA_5.5_Days$RCI_ind_pooledSD_jse),
              Datasets = as_factor(rep(c("EMA_30.30", "EMA_5.5_Window", "EMA_5.5_Days"), 
                                       each = length(EMA_30.30$RCI_ind_pooledSD_jse))))#<<

temp %>%
  ggplot(aes(x = Jackknife_SE, fill = Datasets)) +
  geom_histogram(alpha = 0.2, position = "identity") +
  labs(x = "Jackknife SE of RCI(ind) With Pooled SDs", y = "Cases") +
  theme_gray()#<<

#ggsave("Plots/k20_EMA_RCI_ind_pooledSD_JK_SE.jpg", width = 6, height = 4)#<<

temp %>% 
  ggplot(aes(x = Datasets, y = Jackknife_SE)) +
  geom_boxplot(fill = "dodgerblue", na.rm = TRUE, outlier.size = 1) +
  labs(x = "Dataset", y = "Jackknife SE of RCI(ind) With Pooled SDs") +
  theme_gray()#<<

#ggsave("Plots/k20_EMA_RCI_ind_pooledSD_JK_SE_Box.jpg", width = 6, height = 4)#<<


temp = tibble(Jackknife_Bias = c(EMA_30.30$RCI_ind_pooledSD_jbias, EMA_5.5_Window$RCI_ind_pooledSD_jbias,
                               EMA_5.5_Days$RCI_ind_pooledSD_jbias),
              Datasets = as_factor(rep(c("EMA_30.30", "EMA_5.5_Window", "EMA_5.5_Days"), 
                                       each = length(EMA_30.30$RCI_ind_pooledSD_jbias))))#<<

temp %>%
  ggplot(aes(x = Jackknife_Bias, fill = Datasets)) +
  geom_histogram(alpha = 0.2, position = "identity") +
  labs(x = "Jackknife Bias of RCI(ind) With Pooled SDs", y = "Cases") +
  theme_gray()#<<

#ggsave("Plots/k20_EMA_RCI_ind_pooledSD_JK_Bias.jpg", width = 6, height = 4)#<<

#temp %>% 
#  ggplot(aes(x = Datasets, y = Jackknife_Bias)) +
#  geom_boxplot(fill = "dodgerblue", na.rm = TRUE, outlier.size = 1) +
#  labs(x = "Dataset", y = "Jackknife Bias of RCI(ind) With Pooled SDs") +
#  theme_gray()#<<
#ggsave("Plots/k20_EMA_RCI_ind_pooledSD_JK_Bias_Box.jpg", width = 6, height = 4)#<<